From 64dbfdec39c675bd644748af3cd712418bd11135 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 20 Oct 2014 19:17:12 +0200 Subject: [PATCH] [multiple changes] 2014-10-20 Eric Botcazou * sem_ch3.adb (Build_Derived_Private_Type): When the parent is untagged and has discriminants, build the implicit full view even if the derived type is a completion, and make it the Underlying_Full_View of the type. (Copy_And_Build): Fix Is_Completion actual parameter in the calls to Build_Derived_Type. (Build_Derived_Record_Type): Likewise. 2014-10-20 Ed Schonberg * sem_ch13.adb: Add guard to convention setting. From-SVN: r216487 --- gcc/ada/ChangeLog | 14 +++++ gcc/ada/sem_ch13.adb | 4 +- gcc/ada/sem_ch3.adb | 127 +++++++++++++++++++++---------------------- 3 files changed, 78 insertions(+), 67 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 759de61734a..f431f804d0a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2014-10-20 Eric Botcazou + + * sem_ch3.adb (Build_Derived_Private_Type): When the parent + is untagged and has discriminants, build the implicit full + view even if the derived type is a completion, and make it + the Underlying_Full_View of the type. + (Copy_And_Build): Fix Is_Completion actual parameter in the calls to + Build_Derived_Type. + (Build_Derived_Record_Type): Likewise. + +2014-10-20 Ed Schonberg + + * sem_ch13.adb: Add guard to convention setting. + 2014-10-20 Robert Dewar * sem_ch3.adb, prj-proc.adb, prj-proc.ads, prj-conf.adb: Minor diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a23001daa48..c1c9eecfff1 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -10705,7 +10705,9 @@ package body Sem_Ch13 is -- Convention - if Typ /= Base_Type (Typ) and then Is_Frozen (Base_Type (Typ)) then + if Is_Record_Type (Typ) + and then Typ /= Base_Type (Typ) and then Is_Frozen (Base_Type (Typ)) + then Set_Convention (Typ, Convention (Base_Type (Typ))); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 7f42291317c..a6368da44fc 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6668,14 +6668,11 @@ package body Sem_Ch3 is Is_Completion : Boolean; Derive_Subps : Boolean := True) is - Loc : constant Source_Ptr := Sloc (N); - Par_Base : constant Entity_Id := Base_Type (Parent_Type); - Par_Scope : constant Entity_Id := Scope (Par_Base); - Der_Base : Entity_Id; - Discr : Entity_Id; - Full_Der : Entity_Id; - Full_P : Entity_Id; - Last_Discr : Entity_Id; + Loc : constant Source_Ptr := Sloc (N); + Par_Base : constant Entity_Id := Base_Type (Parent_Type); + Par_Scope : constant Entity_Id := Scope (Par_Base); + Full_Der : Entity_Id := Empty; + Full_P : Entity_Id; procedure Build_Full_Derivation; -- Build full derivation, i.e. derive from the full view @@ -6796,7 +6793,8 @@ package body Sem_Ch3 is else Build_Derived_Type - (Full_N, Full_Parent, Full_Der, True, Derive_Subps => False); + (Full_N, Full_Parent, Full_Der, + Is_Completion => False, Derive_Subps => False); end if; -- The full declaration has been introduced into the tree and @@ -6815,7 +6813,8 @@ package body Sem_Ch3 is Set_Associated_Node_For_Itype (Full_Der, N); Set_Parent (Full_Der, N); Build_Derived_Type - (N, Full_Parent, Full_Der, True, Derive_Subps => False); + (N, Full_Parent, Full_Der, + Is_Completion => False, Derive_Subps => False); end if; Set_Has_Private_Declaration (Full_Der); @@ -6945,40 +6944,17 @@ package body Sem_Ch3 is return; elsif Has_Discriminants (Parent_Type) then - if Present (Full_View (Parent_Type)) then - if not Is_Completion then - -- If this is not a completion, construct the implicit full - -- view by deriving from the full view of the parent type. - - Build_Full_Derivation; - - else - -- If this is a completion, the full view being built is itself - -- private. We build a subtype of the parent with the same - -- constraints as this full view, to convey to the back end the - -- constrained components and the size of this subtype. If the - -- parent is constrained, its full view can serve as the - -- underlying full view of the derived type. - - if No (Discriminant_Specifications (N)) then - if Nkind (Subtype_Indication (Type_Definition (N))) = - N_Subtype_Indication - then - Build_Underlying_Full_View (N, Derived_Type, Parent_Type); - - elsif Is_Constrained (Full_View (Parent_Type)) then - Set_Underlying_Full_View - (Derived_Type, Full_View (Parent_Type)); - end if; - - else - -- If there are new discriminants, the parent subtype is - -- constrained by them, but it is not clear how to build - -- the Underlying_Full_View in this case??? + -- Build the full derivation if this is not the anonymous derived + -- base type created by Build_Derived_Record_Type in the constrained + -- case (see point 5. of its head comment) since we build it for the + -- derived subtype. And skip it for protected types altogether, as + -- gigi does not use these types directly. - null; - end if; - end if; + if Present (Full_View (Parent_Type)) + and then not Is_Itype (Derived_Type) + and then not (Ekind (Full_View (Parent_Type)) in Protected_Kind) + then + Build_Full_Derivation; end if; -- Build partial view of derived type from partial view of parent @@ -6986,35 +6962,54 @@ package body Sem_Ch3 is Build_Derived_Record_Type (N, Parent_Type, Derived_Type, Derive_Subps); - if Present (Full_View (Parent_Type)) and then not Is_Completion then - -- Install full view in derived type (base type and subtype) + if Present (Full_Der) then + declare + Der_Base : constant Entity_Id := Base_Type (Derived_Type); + Discr : Entity_Id; + Last_Discr : Entity_Id; - Der_Base := Base_Type (Derived_Type); - Set_Full_View (Derived_Type, Full_Der); - Set_Full_View (Der_Base, Base_Type (Full_Der)); + begin + -- If this is not a completion, construct the implicit full + -- view by deriving from the full view of the parent type. + -- But if this is a completion, the derived private type + -- being built is a full view and the full derivation can + -- only be its underlying full view. + + if not Is_Completion then + Set_Full_View (Derived_Type, Full_Der); + else + Set_Underlying_Full_View (Derived_Type, Full_Der); + end if; - -- Copy the discriminant list from full view to the partial views - -- (base type and its subtype). Gigi requires that the partial and - -- full views have the same discriminants. + if not Is_Base_Type (Derived_Type) then + Set_Full_View (Der_Base, Base_Type (Full_Der)); + end if; - -- Note that since the partial view is pointing to discriminants - -- in the full view, their scope will be that of the full view. - -- This might cause some front end problems and need adjustment??? + -- Copy the discriminant list from full view to the partial + -- view (base type and its subtype). Gigi requires that the + -- partial and full views have the same discriminants. - Discr := First_Discriminant (Base_Type (Full_Der)); - Set_First_Entity (Der_Base, Discr); + -- Note that since the partial view points to discriminants + -- in the full view, their scope will be that of the full + -- view. This might cause some front end problems and need + -- adjustment??? - loop - Last_Discr := Discr; - Next_Discriminant (Discr); - exit when No (Discr); - end loop; + Discr := First_Discriminant (Base_Type (Full_Der)); + Set_First_Entity (Der_Base, Discr); - Set_Last_Entity (Der_Base, Last_Discr); + loop + Last_Discr := Discr; + Next_Discriminant (Discr); + exit when No (Discr); + end loop; - Set_First_Entity (Derived_Type, First_Entity (Der_Base)); - Set_Last_Entity (Derived_Type, Last_Entity (Der_Base)); - Set_Stored_Constraint (Full_Der, Stored_Constraint (Derived_Type)); + Set_Last_Entity (Der_Base, Last_Discr); + Set_First_Entity (Derived_Type, First_Entity (Der_Base)); + Set_Last_Entity (Derived_Type, Last_Entity (Der_Base)); + + Set_Stored_Constraint + (Full_Der, Stored_Constraint (Derived_Type)); + end; end if; elsif Present (Full_View (Parent_Type)) @@ -7859,7 +7854,7 @@ package body Sem_Ch3 is Build_Derived_Type (New_Decl, Parent_Base, New_Base, - Is_Completion => True, Derive_Subps => False); + Is_Completion => False, Derive_Subps => False); -- ??? This needs re-examination to determine whether the -- above call can simply be replaced by a call to Analyze. -- 2.30.2