From: Eric Botcazou <ebotcazou@adacore.com>
Date: Sat, 18 Dec 2021 21:25:20 +0000 (+0100)
Subject: [Ada] Fix a couple of issues with pragma Inspection_Point
X-Git-Tag: basepoints/gcc-13~1952
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=13e04137665e2e7cab689c280eab7875e4318e0d;p=thirdparty%2Fgcc.git

[Ada] Fix a couple of issues with pragma Inspection_Point

gcc/ada/

	* exp_prag.adb (Expand_Pragma_Inspection_Point): Do a single pass
	over the arguments of the pragma.  Set the Address_Taken flag on
	them and use the Has_Delayed_Freeze flag to spot those which have
	their elaboration delayed.  Reuse the location variable Loc.
---

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index f19eedfaad7a..267657fed0f0 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -2354,12 +2354,13 @@ package body Exp_Prag is
 
    procedure Expand_Pragma_Inspection_Point (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
+
       A     : List_Id;
       Assoc : Node_Id;
-      S     : Entity_Id;
       E     : Entity_Id;
+      Rip   : Boolean;
+      S     : Entity_Id;
 
-      Remove_Inspection_Point : Boolean := False;
    begin
       if No (Pragma_Argument_Associations (N)) then
          A := New_List;
@@ -2389,45 +2390,47 @@ package body Exp_Prag is
          Set_Pragma_Argument_Associations (N, A);
       end if;
 
-      --  Expand the arguments of the pragma. Expanding an entity reference
-      --  is a noop, except in a protected operation, where a reference may
-      --  have to be transformed into a reference to the corresponding prival.
-      --  Are there other pragmas that may require this ???
+      --  Process the arguments of the pragma and expand them. Expanding an
+      --  entity reference is a noop, except in a protected operation, where
+      --  a reference may have to be transformed into a reference to the
+      --  corresponding prival. Are there other pragmas that require this ???
 
+      Rip := False;
       Assoc := First (Pragma_Argument_Associations (N));
       while Present (Assoc) loop
-         Expand (Expression (Assoc));
-         Next (Assoc);
-      end loop;
+         --  The back end may need to take the address of the object
 
-      --  If any of the references have a freeze node, it must appear before
-      --  pragma Inspection_Point, otherwise the entity won't be available when
-      --  Gigi processes Inspection_Point.
-      --  When this requirement isn't met, turn the pragma into a no-op.
+         Set_Address_Taken (Entity (Expression (Assoc)));
 
-      Assoc := First (Pragma_Argument_Associations (N));
-      while Present (Assoc) loop
+         Expand (Expression (Assoc));
+
+         --  If any of the objects have a freeze node, it must appear before
+         --  pragma Inspection_Point, otherwise the entity won't be elaborated
+         --  when Gigi processes the pragma.
 
-         if Present (Freeze_Node (Entity (Expression (Assoc)))) and then
-           not Is_Frozen (Entity (Expression (Assoc)))
+         if Has_Delayed_Freeze (Entity (Expression (Assoc)))
+           and then not Is_Frozen (Entity (Expression (Assoc)))
          then
-            Error_Msg_NE ("??inspection point references unfrozen object &",
-              Assoc,
-              Entity (Expression (Assoc)));
-            Remove_Inspection_Point := True;
+            Error_Msg_NE
+              ("??inspection point references unfrozen object &",
+               Assoc,
+               Entity (Expression (Assoc)));
+            Rip := True;
          end if;
 
          Next (Assoc);
       end loop;
 
-      if Remove_Inspection_Point then
+      --  When the above requirement isn't met, turn the pragma into a no-op
+
+      if Rip then
          Error_Msg_N ("\pragma will be ignored", N);
 
          --  We can't just remove the pragma from the tree as it might be
          --  iterated over by the caller. Turn it into a null statement
          --  instead.
 
-         Rewrite (N, Make_Null_Statement (Sloc (N)));
+         Rewrite (N, Make_Null_Statement (Loc));
       end if;
    end Expand_Pragma_Inspection_Point;