From 7c15c6dd02a2a62ed68ada52e563775665320c21 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 6 Sep 2017 11:54:26 +0200 Subject: [PATCH] [multiple changes] 2017-09-06 Eric Botcazou * sem_ch7.adb (Has_Referencer): Move up and expand comment explaining the test used to detect inlining. Use same test in second occurrence. (Analyze_Package_Body_Helper): Minor formatting fixes. 2017-09-06 Ed Schonberg * exp_ch4.adb (Handle_Changed_Representation): For an untagged derived type with a mixture of renamed and constrained parent discriminants, the constraint for the target must obtain the discriminant values from both the operand and from the stored constraint for it, given that the constrained discriminants are not visible in the object. * exp_ch5.adb (Make_Field_Assign): The type of the right-hand side may be derived from that of the left-hand side (as in the case of an assignment with a change of representation) so the discriminant to be used in the retrieval of the value of the component must be the entity in the type of the right-hand side. From-SVN: r251763 --- gcc/ada/ChangeLog | 23 ++++++++++++-- gcc/ada/exp_ch4.adb | 76 ++++++++++++++++++++++++++++++++++++--------- gcc/ada/exp_ch5.adb | 16 ++++++++-- gcc/ada/sem_ch7.adb | 30 +++++++++--------- 4 files changed, 112 insertions(+), 33 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5667112694d..d91c4b36784 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2017-09-06 Eric Botcazou + + * sem_ch7.adb (Has_Referencer): Move up and expand comment + explaining the test used to detect inlining. Use same test + in second occurrence. + (Analyze_Package_Body_Helper): Minor formatting fixes. + +2017-09-06 Ed Schonberg + + * exp_ch4.adb (Handle_Changed_Representation): For an untagged + derived type with a mixture of renamed and constrained parent + discriminants, the constraint for the target must obtain the + discriminant values from both the operand and from the stored + constraint for it, given that the constrained discriminants are + not visible in the object. + * exp_ch5.adb (Make_Field_Assign): The type of the right-hand + side may be derived from that of the left-hand side (as in the + case of an assignment with a change of representation) so the + discriminant to be used in the retrieval of the value of the + component must be the entity in the type of the right-hand side. + 2017-09-06 Hristian Kirtchev * sem_ch3.adb, sem_ch7.adb, sem_util.adb, g-debpoo.adb, sem_ch4.adb, @@ -11,7 +32,6 @@ * sem_prag.adb: Update description of Eliminate. - 2017-09-06 Ed Schonberg * sem_attr.adb (Analyze_Attribute, case 'Loop_Entry): Handle @@ -179,7 +199,6 @@ * fe.h (Eliminate_Error_Msg): Remove. - 2017-09-05 Richard Sandiford * gcc-interface/utils.c (make_packable_type): Update call to diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index bda0efef86a..7f64cde371d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10627,7 +10627,6 @@ package body Exp_Ch4 is Temp : Entity_Id; Decl : Node_Id; Odef : Node_Id; - Disc : Node_Id; N_Ix : Node_Id; Cons : List_Id; @@ -10657,22 +10656,69 @@ package body Exp_Ch4 is if not Is_Constrained (Target_Type) then if Has_Discriminants (Operand_Type) then - Disc := First_Discriminant (Operand_Type); - if Disc /= First_Stored_Discriminant (Operand_Type) then - Disc := First_Stored_Discriminant (Operand_Type); - end if; + -- A change of representation can only apply to untagged + -- types. We need to build the constraint that applies to + -- the target type, using the constraints of the operand. + -- The analysis is complicated if there are both inherited + -- discriminants and constrained discriminants. + -- We iterate over the discriminants of the target, and + -- find the discriminant of the same name: - Cons := New_List; - while Present (Disc) loop - Append_To (Cons, - Make_Selected_Component (Loc, - Prefix => - Duplicate_Subexpr_Move_Checks (Operand), - Selector_Name => - Make_Identifier (Loc, Chars (Disc)))); - Next_Discriminant (Disc); - end loop; + -- a) If there is a corresponding discriminant in the object + -- then the value is a selected component of the operand. + + -- b) Otherwise the value of a constrained discriminant is + -- found in the stored constraint of the operand. + + declare + Stored : constant Elist_Id := + Stored_Constraint (Operand_Type); + + Elmt : Elmt_Id; + + Disc_O : Entity_Id; + -- Discriminant of the operand type. Its value in the + -- the object is captured in a selected component. + + Disc_S : Entity_Id; + -- Stored discriminant of the operand. If present, it + -- corresponds to a constrained discriminant of the + -- parent type. + + Disc_T : Entity_Id; + -- Discriminant of the target type + + begin + Disc_T := First_Discriminant (Target_Type); + Disc_O := First_Discriminant (Operand_Type); + Disc_S := First_Stored_Discriminant (Operand_Type); + + if Present (Stored) then + Elmt := First_Elmt (Stored); + end if; + + Cons := New_List; + while Present (Disc_T) loop + if Present (Disc_O) + and then Chars (Disc_T) = Chars (Disc_O) + then + Append_To (Cons, + Make_Selected_Component (Loc, + Prefix => + Duplicate_Subexpr_Move_Checks (Operand), + Selector_Name => + Make_Identifier (Loc, Chars (Disc_O)))); + Next_Discriminant (Disc_O); + + elsif Present (Disc_S) then + Append_To (Cons, New_Copy_Tree (Node (Elmt))); + Next_Elmt (Elmt); + end if; + + Next_Discriminant (Disc_T); + end loop; + end; elsif Is_Array_Type (Operand_Type) then N_Ix := First_Index (Target_Type); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 5267024bc6e..59af6ab172b 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1448,9 +1448,21 @@ package body Exp_Ch5 is U_U : Boolean := False) return Node_Id is A : Node_Id; + Disc : Entity_Id; Expr : Node_Id; begin + + -- The discriminant entity to be used in the retrieval below must + -- be one in the corresponding type, given that the assignment + -- may be between derived and parent types. + + if Is_Derived_Type (Etype (Rhs)) then + Disc := Find_Component (R_Typ, C); + else + Disc := C; + end if; + -- In the case of an Unchecked_Union, use the discriminant -- constraint value as on the right-hand side of the assignment. @@ -1463,7 +1475,7 @@ package body Exp_Ch5 is Expr := Make_Selected_Component (Loc, Prefix => Duplicate_Subexpr (Rhs), - Selector_Name => New_Occurrence_Of (C, Loc)); + Selector_Name => New_Occurrence_Of (Disc, Loc)); end if; A := diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 1ec33951c78..e62d7e189df 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -392,6 +392,13 @@ package body Sem_Ch7 is -- An inlined subprogram body acts as a referencer + -- Note that we test Has_Pragma_Inline here in addition + -- to Is_Inlined. We are doing this for a client, since + -- we are computing which entities should be public, and + -- it is the client who will decide if actual inlining + -- should occur, so we need to catch all cases where the + -- subprogram may be inlined by the client. + if Is_Inlined (Decl_Id) or else Has_Pragma_Inline (Decl_Id) then @@ -413,18 +420,13 @@ package body Sem_Ch7 is else Decl_Id := Defining_Entity (Decl); - -- An inlined body acts as a referencer. Note that an - -- inlined subprogram remains Is_Public as gigi requires - -- the flag to be set. - - -- Note that we test Has_Pragma_Inline here rather than - -- Is_Inlined. We are compiling this for a client, and - -- it is the client who will decide if actual inlining - -- should occur, so we need to assume that the procedure - -- could be inlined for the purpose of accessing global - -- entities. + -- An inlined body acts as a referencer, see above. Note + -- that an inlined subprogram remains Is_Public as gigi + -- requires the flag to be set. - if Has_Pragma_Inline (Decl_Id) then + if Is_Inlined (Decl_Id) + or else Has_Pragma_Inline (Decl_Id) + then if Top_Level and then not Contains_Subprograms_Refs (Decl) then @@ -915,11 +917,11 @@ package body Sem_Ch7 is -- down the number of global symbols that do not neet public visibility -- as this has two beneficial effects: -- (1) It makes the compilation process more efficient. - -- (2) It gives the code generatormore freedom to optimize within each + -- (2) It gives the code generator more leeway to optimize within each -- unit, especially subprograms. - -- This is done only for top level library packages or child units as - -- the algorithm does a top down traversal of the package body. + -- This is done only for top-level library packages or child units as + -- the algorithm does a top-down traversal of the package body. if (Scope (Spec_Id) = Standard_Standard or else Is_Child_Unit (Spec_Id)) and then not Is_Generic_Unit (Spec_Id) -- 2.30.2