[Ada] Fix problem with variable-sized return value

[Eric Botcazou <ebotcazou at adacore dot com>]

The compilation aborts because the middle-end is trying to create a temporary 
of non-constant size for a return value whose type is constrained but derived 
from a discriminated type.  The value is returned by copy at the language 
level but it will be returned by reference at the middle-end level, i.e. the 
address of a return slot must be passed to the callee.

Gigi has a mechanism to reuse the target of the assignment for the return slot
(return by target pointer).  It has only been used for unconstrained types so 
far but it can be reused in this case.

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


2008-04-18  Eric Botcazou  <ebotcazou@adacore.com>

        * decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>: Use the return by
        target pointer mechanism as soon as the size is not constant.


2008-04-18  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/varsize_return.ads: New test.
	* gnat.dg/specs/varsize_return_pkg1.ad[sb]: New helper.
	* gnat.dg/specs/varsize_return_pkg2.ad[sb]: Likewise.


-- 
Eric Botcazou

-- { dg-do compile }
-- { dg-options "-gnatws" }

with Varsize_Return_Pkg1;

package Varsize_Return is

  package P is new Varsize_Return_Pkg1 (Id_T => Natural);

end Varsize_Return;

-- { dg-excess-errors "no code generated" }

generic
  type Id_T is private;
  type Data_T is private;
package Varsize_Return_Pkg2 is
  type T is private;
  function Get (X : T) return Data_T;
private
  type T is null record;
end Varsize_Return_Pkg2;

-- { dg-excess-errors "no code generated" }

with Varsize_Return_Pkg2;

generic
  type Id_T is range <>;
package Varsize_Return_Pkg1 is
  
  type Variable_Data_T (Fixed : Boolean := False) is
    record
      case Fixed is
        when True =>
          Length : Natural;
        when False =>
          null;
      end case;
    end record;
  
  function Is_Fixed return Boolean;

  type Variable_Data_Fixed_T is new Variable_Data_T (Is_Fixed);
  
  package Db is new Varsize_Return_Pkg2 (Id_T => Id_T,
                                         Data_T => Variable_Data_Fixed_T);

end Varsize_Return_Pkg1;

package body Varsize_Return_Pkg2 is
  function Get (X : T) return Data_T is
    Result : Data_T;
  begin
    return Result;
  end;
end Varsize_Return_Pkg2;

package body Varsize_Return_Pkg1 is
  
  function Is_Fixed return Boolean is
  begin
    return True;
  end Is_Fixed;

  function Do_Item (I : Natural) return Variable_Data_Fixed_T is
    It : Variable_Data_Fixed_T;
  begin
    return It;
  end Do_Item;

  My_Db : Db.T;

  procedure Run is
    Kitem : Variable_Data_Fixed_T;
    I : Natural;
  begin
    Kitem := Db.Get (My_Db);
    Kitem := Do_Item (I);
  end Run;

end Varsize_Return_Pkg1;

Index: decl.c
===================================================================
--- decl.c	(revision 134390)
+++ decl.c	(working copy)
@@ -3725,11 +3725,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 		     || Has_Foreign_Convention (gnat_entity)))
 	  gnu_return_type = TREE_TYPE (TYPE_FIELDS (gnu_return_type));
 
-	/* If the return type is unconstrained, that means it must have a
-	   maximum size.  We convert the function into a procedure and its
-	   caller will pass a pointer to an object of that maximum size as the
-	   first parameter when we call the function.  */
-	if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
+	/* If the return type has a non-constant size, we convert the function
+	   into a procedure and its caller will pass a pointer to an object as
+	   the first parameter when we call the function.  This can happen for
+	   an unconstrained type with a maximum size or a constrained type with
+	   a size not known at compile time.  */
+	if (TYPE_SIZE_UNIT (gnu_return_type)
+	    && !TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type)))
 	  {
 	    returns_by_target_ptr = true;
 	    gnu_param_list