ada: Fix pragma Warnings and -gnatD interaction

A recent change broke pragma Warnings when -gnatD is enabled in some
cases. This patch fixes this by caching more slocs at times when it's
known that they haven't been modified by -gnatD.

gcc/ada/

	* errout.adb (Validate_Specific_Warnings): Adapt to record
	definition change.
	* erroutc.adb (Set_Specific_Warning_On, Set_Specific_Warning_Off,
	Warning_Specifically_Suppressed): Likewise.
	* erroutc.ads: Change record definition.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index f10539d09492f7b0ff3f6fba55812522e0c94800..92c4f6a46350fbc97b86e5208633d60cce3fd049 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -2028,7 +2028,7 @@ package body Errout is
                if SWE.Open then
                   Error_Msg_N
                     ("?.w?pragma Warnings Off with no matching Warnings On",
-                     SWE.Start);
+                     SWE.Node);
 
                --  Warn for ineffective Warnings (Off, ..)
 
@@ -2043,7 +2043,7 @@ package body Errout is
                then
                   Error_Msg_N
                     ("?.w?no warning suppressed by this pragma",
-                     SWE.Start);
+                     SWE.Node);
                end if;
             end if;
          end;

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 96d8d128d843467d37d980eb4de8d87e05192492..be200e0016e39a9267bd7db99d0f02ba1d388527 100644 (file)
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -1660,9 +1660,10 @@ package body Erroutc is
       Loc : constant Source_Ptr := Sinfo.Nodes.Sloc (Node);
    begin
       Specific_Warnings.Append
-        ((Start      => Node,
+        ((Start      => Loc,
           Msg        => new String'(Msg),
           Stop       => Source_Last (Get_Source_File_Index (Loc)),
+          Node       => Node,
           Reason     => Reason,
           Open       => True,
           Used       => Used,
@@ -1682,13 +1683,12 @@ package body Erroutc is
       for J in 1 .. Specific_Warnings.Last loop
          declare
             SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
-            Start_Loc : constant Source_Ptr := Sinfo.Nodes.Sloc (SWE.Start);
 
          begin
             if Msg = SWE.Msg.all
-              and then Loc > Start_Loc
+              and then Loc > SWE.Start
               and then SWE.Open
-              and then Get_Source_File_Index (Start_Loc) =
+              and then Get_Source_File_Index (SWE.Start) =
                        Get_Source_File_Index (Loc)
             then
                SWE.Stop := Loc;
@@ -1819,13 +1819,12 @@ package body Erroutc is
       for J in Specific_Warnings.First .. Specific_Warnings.Last loop
          declare
             SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
-            Start_Loc : constant Source_Ptr := Sinfo.Nodes.Sloc (SWE.Start);
          begin
             --  Pragma applies if it is a configuration pragma, or if the
             --  location is in range of a specific non-configuration pragma.
 
             if SWE.Config
-              or else Sloc_In_Range (Loc, Start_Loc, SWE.Stop)
+              or else Sloc_In_Range (Loc, SWE.Start, SWE.Stop)
             then
                if Matches (Msg.all, SWE.Msg.all)
                  or else Matches (Tag, SWE.Msg.all)

diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 250461f4b5c55b267a60059ed5011ab900398d73..1c43bce2b21cfe78b08afc29d8101c74da7b1ae4 100644 (file)
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -347,11 +347,19 @@ package Erroutc is
    --  which is the pattern to match for suppressing a warning.
 
    type Specific_Warning_Entry is record
-      Start : Node_Id;
+      Start : Source_Ptr;
       Stop  : Source_Ptr;
       --  Starting and ending source pointers for the range. These are always
       --  from the same source file.
 
+      Node : Node_Id;
+      --  Node for the pragma Warnings occurrence. We store it to compute the
+      --  enclosing subprogram if -gnatdJ is enabled and a message about this
+      --  clause needs to be emitted. Note that we cannot remove the Start
+      --  component above and use Sloc (Node) on message display instead
+      --  because -gnatD output can already have messed with slocs at the point
+      --  when warnings about ineffective clauses are emitted.
+
       Reason : String_Id;
       --  Reason string from pragma Warnings, or null string if none