From eb0d08adb60fc39d59f8de378074b751a18cd184 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Tue, 13 Oct 2020 12:23:11 -0700 Subject: [PATCH] [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. --- gcc/ada/exp_ch2.adb | 44 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index 5c3435b75a0..6c41e08e9ad 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -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); -- 2.30.2