From 24e7a4a06e13c9e1d72ccdc26b26852a423f053e Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 9 Jan 2012 21:08:53 +0000 Subject: trans.c (call_to_gnu): Create the temporary for the return value in the variable-sized return type... * gcc-interface/trans.c (call_to_gnu): Create the temporary for the return value in the variable-sized return type case if the target is an array with fixed size. However, do not create it if this is the expression of an object declaration. From-SVN: r183033 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/gcc-interface/trans.c | 21 ++++++++++++++------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/array18.adb | 9 +++++++++ gcc/testsuite/gnat.dg/array18_pkg.ads | 9 +++++++++ 5 files changed, 44 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/array18.adb create mode 100644 gcc/testsuite/gnat.dg/array18_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 83019eb..15175d0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,12 @@ 2012-01-09 Eric Botcazou + * gcc-interface/trans.c (call_to_gnu): Create the temporary for the + return value in the variable-sized return type case if the target is + an array with fixed size. However, do not create it if this is the + expression of an object declaration. + +2012-01-09 Eric Botcazou + * gcc-interface/trans.c (addressable_p) : Fix thinko. 2012-01-06 Robert Dewar diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 580b492..01fdd49 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -3631,15 +3631,22 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, } /* First, create the temporary for the return value if we need it: for a - variable-sized return type if there is no target or if this is slice, - because the gimplifier doesn't support these cases; or for a function - with copy-in/copy-out parameters if there is no target, because we'll - need to preserve the return value before copying back the parameters. - This must be done before we push a new binding level around the call - as we will pop it before copying the return value. */ + variable-sized return type if there is no target and this is not an + object declaration, or else there is a target and it is a slice or an + array with fixed size, as the gimplifier doesn't handle these cases; + otherwise for a function with copy-in/copy-out parameters if there is + no target, because we need to preserve the return value before copying + back the parameters. This must be done before we push a binding level + around the call as we will pop it before copying the return value. */ if (function_call && ((TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST - && (!gnu_target || TREE_CODE (gnu_target) == ARRAY_RANGE_REF)) + && ((!gnu_target + && Nkind (Parent (gnat_node)) != N_Object_Declaration) + || (gnu_target + && (TREE_CODE (gnu_target) == ARRAY_RANGE_REF + || (TREE_CODE (TREE_TYPE (gnu_target)) == ARRAY_TYPE + && TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_target))) + == INTEGER_CST))))) || (!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type)))) gnu_retval = create_temporary ("R", gnu_result_type); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 32fcb49..e9976b9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-01-09 Eric Botcazou + + * gnat.dg/array18.adb: New test. + * gnat.dg/array18_pkg.ads: New helper. + 2012-01-09 Paul Thomas PR fortran/51791 diff --git a/gcc/testsuite/gnat.dg/array18.adb b/gcc/testsuite/gnat.dg/array18.adb new file mode 100644 index 0000000..54c7744 --- /dev/null +++ b/gcc/testsuite/gnat.dg/array18.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } + +with Array18_Pkg; use Array18_Pkg; + +procedure Array18 is + A : String (1 .. 1); +begin + A := F; +end; diff --git a/gcc/testsuite/gnat.dg/array18_pkg.ads b/gcc/testsuite/gnat.dg/array18_pkg.ads new file mode 100644 index 0000000..9e44109 --- /dev/null +++ b/gcc/testsuite/gnat.dg/array18_pkg.ads @@ -0,0 +1,9 @@ +package Array18_Pkg is + + function N return Positive; + + subtype S is String (1 .. N); + + function F return S; + +end Array18_Pkg; -- cgit v1.1