diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2021-12-18 22:25:20 +0100 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-01-07 16:24:11 +0000 |
commit | 13e04137665e2e7cab689c280eab7875e4318e0d (patch) | |
tree | 1bb075d7889e8fe06eda19842bd6abc8d99260e9 /gcc | |
parent | d1e0b1be622e2beb55babe892691cc56ea20263d (diff) | |
download | gcc-13e04137665e2e7cab689c280eab7875e4318e0d.zip gcc-13e04137665e2e7cab689c280eab7875e4318e0d.tar.gz gcc-13e04137665e2e7cab689c280eab7875e4318e0d.tar.bz2 |
[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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/exp_prag.adb | 49 |
1 files changed, 26 insertions, 23 deletions
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index f19eedf..267657f 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; |