[gcc r13-1667] [Ada] Fix for visibility of aspect expressions inside generic units

[gcc r13-1667] [Ada] Fix for visibility of aspect expressions inside generic units

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:6beeff028f40697a73ac01c3ee715960507849e4

commit r13-1667-g6beeff028f40697a73ac01c3ee715960507849e4
Author: Piotr Trojanek <trojanek@adacore.com>
Date:   Fri Jul 8 00:05:36 2022 +0200

    [Ada] Fix for visibility of aspect expressions inside generic units
    
    When a generic unit contains references to global entities (i.e.
    entities declared outside of this generic unit), those references are
    saved: from the analyzed copy of a generic unit (which is then
    discarded) into a generic template (which is then instantiated, possibly
    many times). To save those references we maintain an association from
    nodes in the generic template to nodes in the analyzed copy. However,
    this association breaks when analysis of the generic copy calls
    Relocate_Node, which conceptually only moves the node, while in fact it
    creates a copy with a new Node_Id.
    
    In particular, this association was broken by calls to Relocate_Node
    that happen when transforming various aspects into corresponding pragmas
    or attribute definition clases. For the most common Pre and Post aspects
    this was fixed years ago by not using Relocate_Node and simply sharing
    the tree.  This patch extends this fix to other aspects, in particular
    those that allow non-static expressions.
    
    gcc/ada/
    
            * sem_ch13.adb (Relocate_Expression): New routine with code that
            previously was only applied to Pre and Post aspects.
            (Analyze_Aspect_Specifications): Apply the above routine to
            other aspects, in particular to aspects Address, Attach_Handler,
            Predicate and Interrupt_Priority.

Diff:
---
 gcc/ada/sem_ch13.adb | 65 ++++++++++++++++++++++++++++------------------------
 1 file changed, 35 insertions(+), 30 deletions(-)

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index c6683108540..7ea04a651e7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1650,6 +1650,18 @@ package body Sem_Ch13 is
       --  pragma of the same kind. Flag Is_Generic should be set when the
       --  context denotes a generic instance.
 
+      function Relocate_Expression (Source : Node_Id) return Node_Id;
+      --  Outside of a generic this function is equivalent to Relocate_Node.
+      --  Inside a generic it is an identity function, because Relocate_Node
+      --  would create a new node that is not associated with the generic
+      --  template. This association is needed to save references to entities
+      --  that are global to the generic (and might be not visible from where
+      --  the generic is instantiated).
+      --
+      --  Inside a generic the original tree is shared between aspect and
+      --  a corresponding pragma (or an attribute definition clause). This
+      --  parallels what is done in sem_prag.adb (see Get_Argument).
+
       --------------
       -- Decorate --
       --------------
@@ -1835,6 +1847,19 @@ package body Sem_Ch13 is
          end if;
       end Insert_Pragma;
 
+      -------------------------
+      -- Relocate_Expression --
+      -------------------------
+
+      function Relocate_Expression (Source : Node_Id) return Node_Id is
+      begin
+         if Inside_A_Generic then
+            return Source;
+         else
+            return Atree.Relocate_Node (Source);
+         end if;
+      end Relocate_Expression;
+
       --  Local variables
 
       Aspect : Node_Id;
@@ -3229,7 +3254,7 @@ package body Sem_Ch13 is
                     Make_Attribute_Definition_Clause (Loc,
                       Name       => Ent,
                       Chars      => Nam,
-                      Expression => Relocate_Node (Expr));
+                      Expression => Relocate_Expression (Expr));
 
                   --  If the address is specified, then we treat the entity as
                   --  referenced, to avoid spurious warnings. This is analogous
@@ -3293,7 +3318,7 @@ package body Sem_Ch13 is
                        Make_Pragma_Argument_Association (Sloc (Ent),
                          Expression => Ent),
                        Make_Pragma_Argument_Association (Sloc (Expr),
-                         Expression => Relocate_Node (Expr))),
+                         Expression => Relocate_Expression (Expr))),
                      Pragma_Name                  => Name_Attach_Handler);
 
                   --  We need to insert this pragma into the tree to get proper
@@ -3335,7 +3360,7 @@ package body Sem_Ch13 is
                        Make_Pragma_Argument_Association (Sloc (Ent),
                          Expression => Ent),
                        Make_Pragma_Argument_Association (Sloc (Expr),
-                         Expression => Relocate_Node (Expr))),
+                         Expression => Relocate_Expression (Expr))),
                      Pragma_Name => Name_Predicate);
 
                   --  Mark type has predicates, and remember what kind of
@@ -3580,7 +3605,7 @@ package body Sem_Ch13 is
                        Make_Attribute_Definition_Clause (Loc,
                          Name       => Ent,
                          Chars      => Nam,
-                         Expression => Relocate_Node (Expr));
+                         Expression => Relocate_Expression (Expr));
                   end if;
 
                --  Suppress/Unsuppress
@@ -4599,32 +4624,12 @@ package body Sem_Ch13 is
 
                   --  Build the precondition/postcondition pragma
 
-                  --  We use Relocate_Node here rather than New_Copy_Tree
-                  --  because subsequent visibility analysis of the aspect
-                  --  depends on this sharing. This should be cleaned up???
-
-                  --  If the context is generic, we want to preserve the
-                  --  original tree, and simply share it between aspect and
-                  --  generated attribute. This parallels what is done in
-                  --  sem_prag.adb (see Get_Argument).
-
-                  declare
-                     New_Expr : Node_Id;
-
-                  begin
-                     if Inside_A_Generic then
-                        New_Expr := Expr;
-                     else
-                        New_Expr := Relocate_Node (Expr);
-                     end if;
-
-                     Aitem := Make_Aitem_Pragma
-                       (Pragma_Argument_Associations => New_List (
-                          Make_Pragma_Argument_Association (Eloc,
-                            Chars      => Name_Check,
-                            Expression => New_Expr)),
-                          Pragma_Name                => Pname);
-                  end;
+                  Aitem := Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Eloc,
+                         Chars      => Name_Check,
+                         Expression => Relocate_Expression (Expr))),
+                       Pragma_Name                => Pname);
 
                   --  Add message unless exception messages are suppressed