[Ada] Don't constant-fold renamed qualified expressions

gcc/ada/

	* exp_ch2.adb (Expand_Entity_Reference): A new local predicate
	Is_Object_Renaming_Name indicates whether a given expression
	occurs (after looking through qualified expressions and type
	conversions) as the name of an object renaming declaration. If
	Current_Value is available but this new predicate is True, then
	ignore the availability of Current_Value.
This commit is contained in:
Steve Baird 2020-10-13 12:23:11 -07:00 committed by Pierre-Marie de Rodat
parent 2d80df4233
commit eb0d08adb6

View File

@ -338,8 +338,43 @@ package body Exp_Ch2 is
-----------------------------
procedure Expand_Entity_Reference (N : Node_Id) is
function Is_Object_Renaming_Name (N : Node_Id) return Boolean;
-- Indicates that N occurs (after accounting for qualified expressions
-- and type conversions) as the name of an object renaming declaration.
-- We don't want to fold values in that case.
-----------------------------
-- Is_Object_Renaming_Name --
-----------------------------
function Is_Object_Renaming_Name (N : Node_Id) return Boolean is
Trailer : Node_Id := N;
Rover : Node_Id;
begin
loop
Rover := Parent (Trailer);
case Nkind (Rover) is
when N_Qualified_Expression | N_Type_Conversion =>
-- Conservative for type conversions; only necessary if
-- conversion does not introduce a new object (as opposed
-- to a new view of an existing object).
null;
when N_Object_Renaming_Declaration =>
return Trailer = Name (Rover);
when others =>
return False; -- the usual case
end case;
Trailer := Rover;
end loop;
end Is_Object_Renaming_Name;
-- Local variables
E : constant Entity_Id := Entity (N);
-- Start of processing for Expand_Entity_Reference
begin
-- Defend against errors
@ -441,10 +476,17 @@ package body Exp_Ch2 is
end;
end if;
-- Interpret possible Current_Value for variable case
-- Interpret possible Current_Value for variable case. The
-- Is_Object_Renaming_Name test is needed for cases such as
-- X : Integer := 1;
-- Y : Integer renames Integer'(X);
-- where the value of Y is changed by any subsequent assignments to X.
-- In cases like this, we do not want to use Current_Value even though
-- it is available.
if Is_Assignable (E)
and then Present (Current_Value (E))
and then not Is_Object_Renaming_Name (N)
then
Expand_Current_Value (N);