[Ada] Fix problem with sliding view conversion on OUT parameter

[Eric Botcazou <ebotcazou at adacore dot com>]

You can invoke a procedure on a cast (type conversion) in Ada, even if the 
formal parameter is Out or In Out; if this case, the conversion is deemed a 
view conversion and is applied in both directions.

Geert just found out that we don't properly handle these view conversions for 
unconstrained array types, because we simply drop them somewhere in gigi.

Fixed thusly, tested on i586-suse-linux, applied on the mainline.


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-12  Geert Bosch  <bosch@adacore.com>

	* gnat.dg/view_conversion1.adb: New test.


-- 
Eric Botcazou

Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 173693)
+++ gcc-interface/trans.c	(working copy)
@@ -3018,12 +3018,18 @@ call_to_gnu (Node_Id gnat_node, tree *gn
 	  /* 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 *gn
 	       && 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);
 

-- { 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;