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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2c022fe6a505f09a93e1879d9f86e03f610188df..420193935713287f25171d88dfe696dc996d0eb6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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;

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index dc79c6fd27087ef0e51cffe7107d5d275c55cf56..6b132353250504e078df418042a27637eaea87aa 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -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);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f6b9ba047dd0500548960ceac91a9d0eb6293b12..e09ae2e91c9a9f236b56c7d84b1dd5a655f5d0f4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gnat.dg/view_conversion1.adb b/gcc/testsuite/gnat.dg/view_conversion1.adb
new file mode 100644 (file)
index 0000000..bb58c1b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/view_conversion1.adb
@@ -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;