diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2009-04-20 08:14:36 +0000 |
---|---|---|
committer | Eric Botcazou <ebotcazou@gcc.gnu.org> | 2009-04-20 08:14:36 +0000 |
commit | 56fe7b052dda1139d25bddad2e9fe9cb6ea222bf (patch) | |
tree | 12b07c2e67856fa1453bb4666308a9705b08eba0 | |
parent | 9fcf2a0bdc78fbb25b2eb2feb7bd19caebcc82bf (diff) | |
download | gcc-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/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/trans.c | 21 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/rep_clause3.adb | 47 |
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; |