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
This commit is contained in:
Eric Botcazou 2012-01-09 21:08:53 +00:00 committed by Eric Botcazou
parent efd2e969f2
commit 24e7a4a06e
5 changed files with 44 additions and 7 deletions

View File

@ -1,3 +1,10 @@
2012-01-09 Eric Botcazou <ebotcazou@adacore.com>
* 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 <ebotcazou@adacore.com>
* gcc-interface/trans.c (addressable_p) <COMPONENT_REF>: Fix thinko.

View File

@ -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);

View File

@ -1,3 +1,8 @@
2012-01-09 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/array18.adb: New test.
* gnat.dg/array18_pkg.ads: New helper.
2012-01-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/51791

View File

@ -0,0 +1,9 @@
-- { dg-do compile }
with Array18_Pkg; use Array18_Pkg;
procedure Array18 is
A : String (1 .. 1);
begin
A := F;
end;

View File

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