trans.c (call_to_gnu): In the by-reference case...
* gcc-interface/trans.c (call_to_gnu): In the by-reference case, if the type of the parameter is an unconstrained array, convert the actual to the type of the formal in the In Out and Out cases as well. From-SVN: r173706
This commit is contained in:
parent
61332f7774
commit
7bf9a5ac1c
@ -1,3 +1,9 @@
|
||||
2011-05-12 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/trans.c (call_to_gnu): In the by-reference case, if the
|
||||
type of the parameter is an unconstrained array, convert the actual to
|
||||
the type of the formal in the In Out and Out cases as well.
|
||||
|
||||
2011-05-11 Nathan Froyd <froydnj@codesourcery.com>
|
||||
|
||||
* gcc-interface/utils.c (def_fn_type): Don't call build_function_type;
|
||||
|
@ -3018,12 +3018,18 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
|
||||
/* There is no need to convert the actual to the formal's type before
|
||||
taking its address. The only exception is for unconstrained array
|
||||
types because of the way we build fat pointers. */
|
||||
else if (TREE_CODE (gnu_formal_type) == UNCONSTRAINED_ARRAY_TYPE)
|
||||
gnu_actual = convert (gnu_formal_type, gnu_actual);
|
||||
if (TREE_CODE (gnu_formal_type) == UNCONSTRAINED_ARRAY_TYPE)
|
||||
{
|
||||
/* Put back a view conversion for In Out or Out parameters. */
|
||||
if (Ekind (gnat_formal) != E_In_Parameter)
|
||||
gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
|
||||
gnu_actual);
|
||||
gnu_actual = convert (gnu_formal_type, gnu_actual);
|
||||
}
|
||||
|
||||
/* The symmetry of the paths to the type of an entity is broken here
|
||||
since arguments don't know that they will be passed by ref. */
|
||||
gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
|
||||
gnu_formal_type = TREE_TYPE (gnu_formal);
|
||||
|
||||
if (DECL_BY_DOUBLE_REF_P (gnu_formal))
|
||||
gnu_actual
|
||||
@ -3036,7 +3042,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
|
||||
&& TREE_CODE (gnu_formal) == PARM_DECL
|
||||
&& DECL_BY_COMPONENT_PTR_P (gnu_formal))
|
||||
{
|
||||
gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
|
||||
gnu_formal_type = TREE_TYPE (gnu_formal);
|
||||
gnu_actual = maybe_implicit_deref (gnu_actual);
|
||||
gnu_actual = maybe_unconstrained_array (gnu_actual);
|
||||
|
||||
|
@ -1,3 +1,7 @@
|
||||
2011-05-12 Geert Bosch <bosch@adacore.com>
|
||||
|
||||
* gnat.dg/view_conversion1.adb: New test.
|
||||
|
||||
2011-05-12 Richard Guenther <rguenther@suse.de>
|
||||
|
||||
PR tree-optimization/48172
|
||||
|
45
gcc/testsuite/gnat.dg/view_conversion1.adb
Normal file
45
gcc/testsuite/gnat.dg/view_conversion1.adb
Normal file
@ -0,0 +1,45 @@
|
||||
-- { dg-do run }
|
||||
-- { dg-options "-gnatws" }
|
||||
|
||||
procedure View_Conversion1 is
|
||||
|
||||
type Matrix is array (Integer range <>, Integer range <>) of Float;
|
||||
|
||||
S1 : Matrix (-3 .. -2, 2 .. 3) := ((2.0, -1.0), (-1.0, 2.0));
|
||||
S2 : Matrix (1 .. 2, 1 .. 2) := S1;
|
||||
S3 : Matrix (2 .. 3, -3 .. -2);
|
||||
S4 : Matrix (1 .. 2, 1 .. 2);
|
||||
|
||||
function Normal_Last (A : Matrix; N : Natural) return Boolean is
|
||||
begin
|
||||
if A'Last (1) = N and then A'Last (2) = N then
|
||||
return True;
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
end;
|
||||
|
||||
procedure Transpose (A : Matrix; B : out Matrix) is
|
||||
N : constant Natural := A'Length (1);
|
||||
subtype Normal_Matrix is Matrix (1 .. N, 1 .. N);
|
||||
begin
|
||||
if not Normal_Last (A, N) or else not Normal_Last (B, N) then
|
||||
Transpose (Normal_Matrix (A), Normal_Matrix (B));
|
||||
return;
|
||||
end if;
|
||||
|
||||
for J in 1 .. N loop
|
||||
for K in 1 .. N loop
|
||||
B (J, K) := A (K, J);
|
||||
end loop;
|
||||
end loop;
|
||||
end;
|
||||
|
||||
begin
|
||||
Transpose (S1, S3);
|
||||
Transpose (S3, S4);
|
||||
|
||||
if S4 /= S2 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
end;
|
Loading…
Reference in New Issue
Block a user