From 9a089d8b0620133f2111a2fd2fc5064166ed02a6 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 18 Apr 2008 10:10:15 +0000 Subject: [PATCH] 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) : Use the return by target pointer mechanism as soon as the size is not constant. From-SVN: r134433 --- gcc/ada/ChangeLog | 5 ++++ gcc/ada/decl.c | 12 +++++---- gcc/testsuite/ChangeLog | 6 +++++ .../gnat.dg/specs/varsize_return.ads | 10 +++++++ .../gnat.dg/specs/varsize_return_pkg1.adb | 24 +++++++++++++++++ .../gnat.dg/specs/varsize_return_pkg1.ads | 26 +++++++++++++++++++ .../gnat.dg/specs/varsize_return_pkg2.adb | 7 +++++ .../gnat.dg/specs/varsize_return_pkg2.ads | 11 ++++++++ 8 files changed, 96 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return.ads create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.adb create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.adb create mode 100644 gcc/testsuite/gnat.dg/specs/varsize_return_pkg2.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 674c299cb18..3f23e2f5d8d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2008-04-18 Eric Botcazou + + * decl.c (gnat_to_gnu_entity) : Use the return by + target pointer mechanism as soon as the size is not constant. + 2008-04-18 Eric Botcazou * gigi.h (create_var_decl_1): Declare. diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index d127ca76c87..254b70a2722 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 63650dc3a8c..339ac3adee6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2008-04-18 Eric Botcazou + + * 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 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 00000000000..b6c55ed635e --- /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 00000000000..59b283c2bb2 --- /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 00000000000..792b7a5ce2c --- /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 00000000000..d8925528512 --- /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 00000000000..9d1abb96cd7 --- /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; -- 2.30.2