trans.c (Call_to_gnu): Strip unchecked conversions on actuals of In parameters if...

	* gcc-interface/trans.c (Call_to_gnu): Strip unchecked conversions on
	actuals of In parameters if the destination type is an unconstrained
	composite type.

From-SVN: r217965

4 files changed, 41 insertions, 6 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 881c2f8..3cde2d8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,11 @@
 2014-11-22  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/trans.c (Call_to_gnu): Strip unchecked conversions on
+	actuals of In parameters if the destination type is an unconstrained
+	composite type.
+
+2014-11-22  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/trans.c (gnat_gimplify_expr): Add 'type' variable.
 	<case NULL_EXPR>: Deal with unconstrained array types and use 'type'.
 	<case ADDR_EXPR>: Use 'type'.
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 3d27dde..1888c19 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -4016,9 +4016,10 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
        gnat_formal = Next_Formal_With_Extras (gnat_formal),
        gnat_actual = Next_Actual (gnat_actual))
     {
+      Entity_Id gnat_formal_type = Etype (gnat_formal);
       tree gnu_formal = present_gnu_tree (gnat_formal)
 			? get_gnu_tree (gnat_formal) : NULL_TREE;
-      tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
+      tree gnu_formal_type = gnat_to_gnu_type (gnat_formal_type);
       const bool is_true_formal_parm
 	= gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL;
       const bool is_by_ref_formal_parm
@@ -4031,13 +4032,16 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 	 address if it's passed by reference or as target of the back copy
 	 done after the call if it uses the copy-in/copy-out mechanism.
 	 We do it in the In case too, except for an unchecked conversion
-	 because it alone can cause the actual to be misaligned and the
-	 addressability test is applied to the real object.  */
+	 to an elementary type or a constrained composite type because it
+	 alone can cause the actual to be misaligned and the addressability
+	 test is applied to the real object.  */
       const bool suppress_type_conversion
 	= ((Nkind (gnat_actual) == N_Unchecked_Type_Conversion
-	    && Ekind (gnat_formal) != E_In_Parameter)
+	    && (Ekind (gnat_formal) != E_In_Parameter
+		|| (Is_Composite_Type (Underlying_Type (gnat_formal_type))
+		    && !Is_Constrained (Underlying_Type (gnat_formal_type)))))
 	   || (Nkind (gnat_actual) == N_Type_Conversion
-	       && Is_Composite_Type (Underlying_Type (Etype (gnat_formal)))));
+	       && Is_Composite_Type (Underlying_Type (gnat_formal_type))));
       Node_Id gnat_name = suppress_type_conversion
 			  ? Expression (gnat_actual) : gnat_actual;
       tree gnu_name = gnat_to_gnu (gnat_name), gnu_name_type;
@@ -4200,7 +4204,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
       if (Ekind (gnat_formal) != E_Out_Parameter
 	  && Do_Range_Check (gnat_actual))
 	gnu_actual
-	  = emit_range_check (gnu_actual, Etype (gnat_formal), gnat_actual);
+	  = emit_range_check (gnu_actual, gnat_formal_type, gnat_actual);
 
       /* Unless this is an In parameter, we must remove any justified modular
 	 building from GNU_NAME to get an lvalue.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 80deed0..5d5706b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
 2014-11-22  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gnat.dg/specs/pack11.ads: New test.
+
+2014-11-22  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gnat.dg/specs/no_streams.ads: New test.
 
 2014-11-22  Uros Bizjak  <ubizjak@gmail.com>
diff --git a/gcc/testsuite/gnat.dg/specs/pack11.ads b/gcc/testsuite/gnat.dg/specs/pack11.ads
new file mode 100644
index 0000000..9a25ec4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/pack11.ads
@@ -0,0 +1,21 @@
+-- { dg-do compile }
+
+with Ada.Strings.Bounded;
+
+package Pack11 is
+
+  package My_Strings is new Ada.Strings.Bounded.Generic_Bounded_Length (4);
+  subtype My_Bounded_String is My_Strings.Bounded_String;
+
+  type Rec1 is tagged null record;
+
+  type Rec2 is record
+    S : My_Bounded_String;
+  end record;
+  pragma Pack (Rec2);
+
+  type Rec3 is new Rec1 with record
+    R : Rec2;
+  end record;
+
+end Pack11;