aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2009-04-20 08:14:36 +0000
committerEric Botcazou <ebotcazou@gcc.gnu.org>2009-04-20 08:14:36 +0000
commit56fe7b052dda1139d25bddad2e9fe9cb6ea222bf (patch)
tree12b07c2e67856fa1453bb4666308a9705b08eba0
parent9fcf2a0bdc78fbb25b2eb2feb7bd19caebcc82bf (diff)
downloadgcc-56fe7b052dda1139d25bddad2e9fe9cb6ea222bf.zip
gcc-56fe7b052dda1139d25bddad2e9fe9cb6ea222bf.tar.gz
gcc-56fe7b052dda1139d25bddad2e9fe9cb6ea222bf.tar.bz2
trans.c (call_to_gnu): When creating the copy for a non-addressable parameter passed by reference...
* 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
-rw-r--r--gcc/ada/ChangeLog7
-rw-r--r--gcc/ada/gcc-interface/trans.c21
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/rep_clause3.adb47
4 files changed, 72 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ca9d4a8..7075b6f 100644
--- 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 83d32a6..0b46b56 100644
--- 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 9b66c9d..df0281d 100644
--- 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
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;