diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 674c299cb18820166847cc0637c4ff83cc0743e2..3f23e2f5d8d407d0cc83b3f857759a18327da117 100644 --- 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 --- 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 --- 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 index 0000000000000000000000000000000000000000..b6c55ed635eb6e52f5724741c9d485c7d361a64c --- /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 index 0000000000000000000000000000000000000000..59b283c2bb2886701f2729b8c05277e5c38e8ebe --- /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 index 0000000000000000000000000000000000000000..792b7a5ce2c92387433a983d5109461b53a71151 --- /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 index 0000000000000000000000000000000000000000..d89255285120d4b552f872de8a86e6e1de3c62d5 --- /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 index 0000000000000000000000000000000000000000..9d1abb96cd785c853a305b5870d499b3b6c44658 --- /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;