Commit d587d1e4 by Eric Botcazou Committed by Eric Botcazou

re PR ada/92362 (double elaboration of expression in Address aspect)

	PR ada/92362
	* gcc-interface/trans.c (gnat_to_gnu) <N_Attribute_Definition_Clause>:
	Use a temporary instead of clobbering the result with a freeze node.

From-SVN: r278675
parent 32bef8ff
2019-11-25 Eric Botcazou <ebotcazou@adacore.com> 2019-11-25 Eric Botcazou <ebotcazou@adacore.com>
PR ada/92362
* gcc-interface/trans.c (gnat_to_gnu) <N_Attribute_Definition_Clause>:
Use a temporary instead of clobbering the result with a freeze node.
2019-11-25 Eric Botcazou <ebotcazou@adacore.com>
PR ada/92575 PR ada/92575
* expect.c (__gnat_expect_poll [VMS, HPUX]): Fix typo. * expect.c (__gnat_expect_poll [VMS, HPUX]): Fix typo.
......
...@@ -8421,7 +8421,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -8421,7 +8421,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnat_temp = Entity (Name (gnat_node)); gnat_temp = Entity (Name (gnat_node));
if (Freeze_Node (gnat_temp)) if (Freeze_Node (gnat_temp))
{ {
tree gnu_address = gnat_to_gnu (Expression (gnat_node)); tree gnu_address = gnat_to_gnu (Expression (gnat_node)), gnu_temp;
/* Get the value to use as the address and save it as the equivalent /* Get the value to use as the address and save it as the equivalent
for the object; when it is frozen, gnat_to_gnu_entity will do the for the object; when it is frozen, gnat_to_gnu_entity will do the
...@@ -8431,7 +8431,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -8431,7 +8431,7 @@ gnat_to_gnu (Node_Id gnat_node)
of the object is limited and it is initialized with the result of of the object is limited and it is initialized with the result of
a function call. */ a function call. */
if (Is_Subprogram (gnat_temp)) if (Is_Subprogram (gnat_temp))
gnu_result = gnu_address; gnu_temp = gnu_address;
else else
{ {
tree gnu_type = gnat_to_gnu_type (Etype (gnat_temp)); tree gnu_type = gnat_to_gnu_type (Etype (gnat_temp));
...@@ -8440,11 +8440,11 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -8440,11 +8440,11 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_type gnu_type
= build_reference_type_for_mode (gnu_type, ptr_mode, true); = build_reference_type_for_mode (gnu_type, ptr_mode, true);
gnu_address = convert (gnu_type, gnu_address); gnu_address = convert (gnu_type, gnu_address);
gnu_result gnu_temp
= build_unary_op (INDIRECT_REF, NULL_TREE, gnu_address); = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_address);
} }
save_gnu_tree (gnat_temp, gnu_result, true); save_gnu_tree (gnat_temp, gnu_temp, true);
} }
break; break;
......
2019-11-25 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/addr14.adb: New test.
2019-11-25 Mark Eggleston <mark.eggleston@codethink.com> 2019-11-25 Mark Eggleston <mark.eggleston@codethink.com>
Jim MacArthur <jim.macarthur@codethink.co.uk> Jim MacArthur <jim.macarthur@codethink.co.uk>
......
-- { dg-do run }
with System;
procedure Addr14 is
type Arr is array (1 .. 4) of aliased Integer;
A : Arr := (1, 2, 3, 4);
I : Natural := 0;
function Get_Address return System.Address is
begin
I := I + 1;
return A(I)'Address;
end;
Foo : Integer with Address => Get_Address;
begin
if Foo /= 1 then
raise Program_Error;
end if;
end;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment