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

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

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:eb0d08adb60fc39d59f8de378074b751a18cd184

commit r11-5348-geb0d08adb60fc39d59f8de378074b751a18cd184
Author: Steve Baird <baird@adacore.com>
Date:   Tue Oct 13 12:23:11 2020 -0700

    [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.

Diff:
---
 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);