trans.c (call_to_gnu): When creating the copy for a non-addressable parameter passed...

	* gcc-interface/trans.c (call_to_gnu): When creating the copy for a
	non-addressable parameter passed by reference, do not convert the
	actual if its type is already the nominal type, unless it is of
	self-referential size.

From-SVN: r146367

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ca9d4a8059a316421080afe35048349a915c467b..7075b6f5e54409127a32b72217abe88111ad46dc 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2009-04-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (call_to_gnu): When creating the copy for a
+       non-addressable parameter passed by reference, do not convert the
+       actual if its type is already the nominal type, unless it is of
+       self-referential size.
+
 2009-04-20  Arnaud Charlet  <charlet@adacore.com>
 
        * gnat_ugn.texi: Fix typos.

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 83d32a68de2f6dbaf01729e8df1b3ab506e87d22..0b46b56a89eb4ff8f1bdb2f4d2801f364e4676af 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -2511,12 +2511,19 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
                             gnat_formal);
            }
 
-         /* Remove any unpadding from the object and reset the copy.  */
-         if (TREE_CODE (gnu_name) == COMPONENT_REF
-             && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
-                  == RECORD_TYPE)
-                 && (TYPE_IS_PADDING_P
-                     (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
+         /* If the actual type of the object is already the nominal type,
+            we have nothing to do, except if the size is self-referential
+            in which case we'll remove the unpadding below.  */
+         if (TREE_TYPE (gnu_name) == gnu_name_type
+             && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_name_type)))
+           ;
+
+         /* Otherwise remove unpadding from the object and reset the copy.  */
+         else if (TREE_CODE (gnu_name) == COMPONENT_REF
+                  && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
+                       == RECORD_TYPE)
+                       && (TYPE_IS_PADDING_P
+                           (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
            gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
 
          /* Otherwise convert to the nominal type of the object if it's
@@ -2529,7 +2536,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
          else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
                   && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
                       || smaller_packable_type_p (TREE_TYPE (gnu_name),
-                                                gnu_name_type)))
+                                                  gnu_name_type)))
            gnu_name = convert (gnu_name_type, gnu_name);
 
          /* Make a SAVE_EXPR to both properly account for potential side

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9b66c9dd950bee061aab2c3fd150fe8ad80b49b8..df0281d96c2004e115e9570de608e323455ceff1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2009-04-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/rep_clause3.adb: New test.
+
 2009-04-19  Joseph Myers  <joseph@codesourcery.com>
 
        PR c/37481

diff --git a/gcc/testsuite/gnat.dg/rep_clause3.adb b/gcc/testsuite/gnat.dg/rep_clause3.adb
new file mode 100644 (file)
index 0000000..f4adcc3
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/rep_clause3.adb
@@ -0,0 +1,47 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Rep_Clause3 is
+
+   subtype U_16 is integer range 0..2**16-1;
+
+   type TYPE1 is range 0 .. 135;
+   for TYPE1'size use 14;
+
+   type TYPE2 is range 0 .. 262_143;
+   for TYPE2'size use 18;
+
+   subtype TYPE3 is integer range 1 .. 21*6;
+
+   type ARR is array (TYPE3 range <>) of boolean;
+   pragma Pack(ARR);
+
+   subtype SUB_ARR is ARR(1 .. 5*6);
+
+   OBJ  : SUB_ARR;
+
+   type R is
+    record
+      N   : TYPE1;
+      L   : TYPE2;
+      I   : SUB_ARR;
+      CRC : U_16;
+     end record;
+    for R use
+     record at mod 4;
+      N   at  0 range  0 .. 13;
+      L   at  0 range 14 .. 31;
+      I   at  4 range  2 .. 37;
+      CRC at  8 range 16 .. 31;
+     end record;
+   for R'size use 12*8;
+
+   type SUB_R is array (1..4) of R;
+
+   T : SUB_R;
+
+begin
+  if OBJ = T(1).I then
+    raise Program_Error;
+  end if;
+end;