diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2013-01-04 09:21:55 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-01-04 10:21:55 +0100 |
| commit | 33bd17e742dc4956590a6ff8d2676f1c8eaf305f (patch) | |
| tree | 29f6c9ea9bb03ebae458ad5bad97ea6dc9873839 /gcc | |
| parent | 5ee96c9da4b521cd593ef2db444bb0337802c184 (diff) | |
| download | gcc-33bd17e742dc4956590a6ff8d2676f1c8eaf305f.zip gcc-33bd17e742dc4956590a6ff8d2676f1c8eaf305f.tar.gz gcc-33bd17e742dc4956590a6ff8d2676f1c8eaf305f.tar.bz2 | |
sem_ch3.adb (Build_Private_Derived_Type): Set Has_Private_Ancestor on type derived from an untagged private type whose...
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.
From-SVN: r194892
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 12 |
3 files changed, 35 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d907d88..fe3d351 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +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. diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 7458324..5e3278a 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -3560,7 +3560,7 @@ package body Sem_Aggr is 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)) @@ -3886,7 +3886,24 @@ package body Sem_Aggr is 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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index f61990e..ccbd511 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6417,8 +6417,9 @@ package body Sem_Ch3 is 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); @@ -6434,7 +6435,12 @@ package body Sem_Ch3 is 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 |