mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-11 13:01:20 +08:00
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
This commit is contained in:
parent
9fcf2a0bdc
commit
56fe7b052d
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
47
gcc/testsuite/gnat.dg/rep_clause3.adb
Normal file
47
gcc/testsuite/gnat.dg/rep_clause3.adb
Normal file
@ -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;
|
Loading…
x
Reference in New Issue
Block a user