[multiple changes]

2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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

4 files changed, 112 insertions, 33 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5667112..d91c4b3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* 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  <schonberg@adacore.com>
+
+	* 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  <kirtchev@adacore.com>
 
 	* 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  <schonberg@adacore.com>
 
 	* sem_attr.adb (Analyze_Attribute, case 'Loop_Entry): Handle
@@ -179,7 +199,6 @@
 
 	* fe.h (Eliminate_Error_Msg): Remove.
 
-
 2017-09-05  Richard Sandiford  <richard.sandiford@linaro.org>
 
 	* 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 bda0efe..7f64cde 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 5267024b..59af6ab 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 1ec3395..e62d7e1 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)