diff mbox series

[COMMITTED,10/17] ada: Improve Inspection_Point warning

Message ID 20240829130750.1651060-10-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,01/17] ada: Update documentation for conditional when constructs | expand

Commit Message

Marc Poulhiès Aug. 29, 2024, 1:07 p.m. UTC 
From: Viljar Indus <indus@adacore.com>

Ensure that the primary and sub message point
to the same location in order to assure that the
submessages get pretty printed in the correct order.

gcc/ada/

	* exp_prag.adb (Expand_Pragma_Inspection_Point): Improve sub
	diagnostic generation.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_prag.adb | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 2c054d1b967..6c328ef36ce 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -2519,11 +2519,11 @@  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;
-      E     : Entity_Id;
-      Rip   : Boolean;
-      S     : Entity_Id;
+      A          : List_Id;
+      Assoc      : Node_Id;
+      Faulty_Arg : Node_Id := Empty;
+      E          : Entity_Id;
+      S          : Entity_Id;
 
    begin
       if No (Pragma_Argument_Associations (N)) then
@@ -2556,7 +2556,6 @@  package body Exp_Prag is
 
       --  Process the arguments of the pragma
 
-      Rip := False;
       Assoc := First (Pragma_Argument_Associations (N));
       while Present (Assoc) loop
          --  The back end may need to take the address of the object
@@ -2574,7 +2573,7 @@  package body Exp_Prag is
               ("??inspection point references unfrozen object &",
                Assoc,
                Entity (Expression (Assoc)));
-            Rip := True;
+            Faulty_Arg := Assoc;
          end if;
 
          Next (Assoc);
@@ -2582,8 +2581,10 @@  package body Exp_Prag is
 
       --  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);
+      if Present (Faulty_Arg) then
+         Error_Msg_Sloc := Sloc (Faulty_Arg);
+         Error_Msg_N ("\pragma Inspection_Point # will be ignored",
+           Faulty_Arg);
 
          --  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