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

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 674c299cb18820166847cc0637c4ff83cc0743e2..3f23e2f5d8d407d0cc83b3f857759a18327da117 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index d127ca76c878de587adb3a1371f774e1c876994b..254b70a272227974e9732460a52705966b3efd0e 100644 (file)
--- a/gcc/ada/decl.c
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 63650dc3a8cef94667162c789443b69acfd2a416..339ac3adee6a5eecc1b12fe7c4c1b2adbfc32af2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return.ads b/gcc/testsuite/gnat.dg/specs/varsize_return.ads
new file mode 100644 (file)
index 0000000..b6c55ed
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/varsize_return.ads
@@ -0,0 +1,10 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb
new file mode 100644 (file)
index 0000000..59b283c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb
@@ -0,0 +1,24 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads
new file mode 100644 (file)
index 0000000..792b7a5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads
@@ -0,0 +1,26 @@
+-- { 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;

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

diff --git a/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads
new file mode 100644 (file)
index 0000000..9d1abb9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads
@@ -0,0 +1,11 @@
+-- { 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;