+2013-01-04 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Build_Private_Derived_Type): Set
+ Has_Private_Ancestor on type derived from an untagged private
+ type whose full view has discriminants
+ * sem_aggr.adb (Resolve_Record_Aggregate): Reject non-extension
+ aggregate for untagged record type with private ancestor.
+
2013-01-04 Thomas Quinot <quinot@adacore.com>
* sem_elab.adb, sem_ch3.adb: Minor reformatting.
end if;
-- AI05-0115: if the ancestor part is a subtype mark, the ancestor
- -- must npt have unknown discriminants.
+ -- must not have unknown discriminants.
if Is_Derived_Type (Typ)
and then Has_Unknown_Discriminants (Root_Type (Typ))
Next_Elmt (Parent_Elmt);
end loop;
+ -- Typ is not a derived tagged type
+
else
+ -- A type derived from an untagged private type whose full view
+ -- has discriminants is constructed as a record type but there
+ -- are no legal aggregates for it.
+
+ if Is_Derived_Type (Typ)
+ and then Has_Private_Ancestor (Typ)
+ and then Nkind (N) /= N_Extension_Aggregate
+ then
+ Error_Msg_Node_2 := Base_Type (Etype (Typ));
+ Error_Msg_NE
+ ("no aggregate available for type& derived from "
+ & "private type&", N, Typ);
+ return;
+ end if;
+
Record_Def := Type_Definition (Parent (Base_Type (Typ)));
if Null_Present (Record_Def) then
and then (In_Open_Scopes (Scope (Parent_Type)))
then
Full_Der :=
- Make_Defining_Identifier
- (Sloc (Derived_Type), Chars (Derived_Type));
+ Make_Defining_Identifier (Sloc (Derived_Type),
+ Chars => Chars (Derived_Type));
+
Set_Is_Itype (Full_Der);
Set_Has_Private_Declaration (Full_Der);
Set_Has_Private_Declaration (Derived_Type);
else
Build_Derived_Record_Type
(N, Full_View (Parent_Type), Derived_Type,
- Derive_Subps => False);
+ Derive_Subps => False);
+
+ -- Except in the context of the full view of the parent, there
+ -- are no non-extension aggregates for the derived type.
+
+ Set_Has_Private_Ancestor (Derived_Type);
end if;
-- In any case, the primitive operations are inherited from the