decl.c (gnat_to_gnu_entity): Use the return by target pointer mechanism as soon…

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

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

From-SVN: r134433

gcc/ada/ChangeLog

 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>
+
 	* gigi.h (create_var_decl_1): Declare.
 	(create_var_decl): Turn into a macro invoking create_var_decl_1.
 	(create_true_var_decl): Likewise.

gcc/ada/decl.c

@@ -3725,11 +3725,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		     || 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

gcc/testsuite/ChangeLog

+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.
+
 2008-04-17  Jason Merrill  <jason@redhat.com>
 
 	PR c++/35773

gcc/testsuite/gnat.dg/specs/varsize_return.ads

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

gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb

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

gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads

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

gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.adb

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

gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads

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