[Ada] Fix ICE on function call returning dynamic array

[Eric Botcazou <ebotcazou at adacore dot com>]

This is a regression present on the mainline.  It occurs only when the return 
value is assigned to an array with fixed size (this is possible with subtypes 
of the same unconstrained array type).

Tested on i586-suse-linux, applied on the mainline.


2012-01-09  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/trans.c (call_to_gnu): Create the temporary for the
	return value in the variable-sized return type case if the target is
	an array with fixed size.  However, do not create it if this is the
	expression of an object declaration.


2012-01-09  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/array18.adb: New test.
	* gnat.dg/array18_pkg.ads: New helper.


-- 
Eric Botcazou

-- { dg-do compile }

with Array18_Pkg; use Array18_Pkg;

procedure Array18 is
   A : String (1 .. 1);
begin
   A := F;
end;

package Array18_Pkg is

   function N return Positive;

   subtype S is String (1 .. N);

   function F return S;

end Array18_Pkg;

Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 183025)
+++ gcc-interface/trans.c	(working copy)
@@ -3631,15 +3631,22 @@ call_to_gnu (Node_Id gnat_node, tree *gn
     }
 
   /* First, create the temporary for the return value if we need it: for a
-     variable-sized return type if there is no target or if this is slice,
-     because the gimplifier doesn't support these cases; or for a function
-     with copy-in/copy-out parameters if there is no target, because we'll
-     need to preserve the return value before copying back the parameters.
-     This must be done before we push a new binding level around the call
-     as we will pop it before copying the return value.  */
+     variable-sized return type if there is no target and this is not an
+     object declaration, or else there is a target and it is a slice or an
+     array with fixed size, as the gimplifier doesn't handle these cases;
+     otherwise for a function with copy-in/copy-out parameters if there is
+     no target, because we need to preserve the return value before copying
+     back the parameters.  This must be done before we push a binding level
+     around the call as we will pop it before copying the return value.  */
   if (function_call
       && ((TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST
-	   && (!gnu_target || TREE_CODE (gnu_target) == ARRAY_RANGE_REF))
+	   && ((!gnu_target
+		&& Nkind (Parent (gnat_node)) != N_Object_Declaration)
+	       || (gnu_target
+		   && (TREE_CODE (gnu_target) == ARRAY_RANGE_REF
+		       || (TREE_CODE (TREE_TYPE (gnu_target)) == ARRAY_TYPE
+			   && TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_target)))
+			      == INTEGER_CST)))))
 	  || (!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type))))
     gnu_retval = create_temporary ("R", gnu_result_type);