trans.c (Call_to_gnu): Strip unchecked conversions on actuals of In parameters if...
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 22 Nov 2014 12:23:47 +0000 (12:23 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sat, 22 Nov 2014 12:23:47 +0000 (12:23 +0000)
* 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

gcc/ada/ChangeLog
gcc/ada/gcc-interface/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/specs/pack11.ads [new file with mode: 0644]

index 881c2f8f7ef30964c0d281482abafd4530810d4e..3cde2d8d434b463f11e79d7a7736a1add5aca277 100644 (file)
@@ -1,3 +1,9 @@
+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.
index 3d27dde709fd24d293688652ebeb15df048ffe7a..1888c194006e44a7b606e285cc03bf5f766520e9 100644 (file)
@@ -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.  */
index 80deed0d419c34f584fa9baf7be6f54fae36c7b3..5d5706b0b5c6bc38f4610206d29fbc44bd933a00 100644 (file)
@@ -1,3 +1,7 @@
+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.
diff --git a/gcc/testsuite/gnat.dg/specs/pack11.ads b/gcc/testsuite/gnat.dg/specs/pack11.ads
new file mode 100644 (file)
index 0000000..9a25ec4
--- /dev/null
@@ -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;