diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index c4761bd1bc9e8c2a98eb64893843fef2bbd59a84..4622290897b9edc8443f7c421b689a3d1121e69e 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -213,6 +213,10 @@ package body Errout is
-- should have 'Class appended to its name (see Add_Class procedure), and
-- is otherwise unchanged.
+ procedure Validate_Specific_Warnings;
+ -- Checks that specific warnings are consistent (for non-configuration
+ -- case, properly closed, and used).
+
function Warn_Insertion return String;
-- This is called for warning messages only (so Warning_Msg_Char is set)
-- and returns a corresponding string to use at the beginning of generated
@@ -1745,7 +1749,7 @@ package body Errout is
-- do this on the last call, after all possible warnings are posted.
if Last_Call then
- Validate_Specific_Warnings (Error_Msg'Access);
+ Validate_Specific_Warnings;
end if;
end Finalize;
@@ -2001,6 +2005,50 @@ package body Errout is
-- True if S starts with Size_For
end Is_Size_Too_Small_Message;
+ --------------------------------
+ -- Validate_Specific_Warnings --
+ --------------------------------
+
+ procedure Validate_Specific_Warnings is
+ begin
+ if not Warnsw.Warn_On_Warnings_Off then
+ return;
+ end if;
+
+ for J in Specific_Warnings.First .. Specific_Warnings.Last loop
+ declare
+ SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
+
+ begin
+ if not SWE.Config then
+
+ -- Warn for unmatched Warnings (Off, ...)
+
+ if SWE.Open then
+ Error_Msg_N
+ ("?.w?pragma Warnings Off with no matching Warnings On",
+ SWE.Start);
+
+ -- Warn for ineffective Warnings (Off, ..)
+
+ elsif not SWE.Used
+
+ -- Do not issue this warning for -Wxxx messages since the
+ -- back-end doesn't report the information. Note that there
+ -- is always an asterisk at the start of every message.
+
+ and then not
+ (SWE.Msg'Length > 3 and then SWE.Msg (2 .. 3) = "-W")
+ then
+ Error_Msg_N
+ ("?.w?no warning suppressed by this pragma",
+ SWE.Start);
+ end if;
+ end if;
+ end;
+ end loop;
+ end Validate_Specific_Warnings;
+
---------------
-- Last_Node --
---------------
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 5a7764aa0a36f26821f1676cd525a7b911c01cc0..089da867d45468366e7fd56f2aaef2f8e3b322b3 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -896,7 +896,7 @@ package Errout is
-- location from which warnings are to be turned back on.
procedure Set_Specific_Warning_Off
- (Loc : Source_Ptr;
+ (Node : Node_Id;
Msg : String;
Reason : String_Id;
Config : Boolean;
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 125cbf822ffc68306c5f9ed7ea119da8db3ec6d8..96d8d128d843467d37d980eb4de8d87e05192492 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -38,6 +38,7 @@ with Fname; use Fname;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
+with Sinfo.Nodes;
with Sinput; use Sinput;
with Snames; use Snames;
with Stringt; use Stringt;
@@ -1650,15 +1651,16 @@ package body Erroutc is
------------------------------
procedure Set_Specific_Warning_Off
- (Loc : Source_Ptr;
+ (Node : Node_Id;
Msg : String;
Reason : String_Id;
Config : Boolean;
Used : Boolean := False)
is
+ Loc : constant Source_Ptr := Sinfo.Nodes.Sloc (Node);
begin
Specific_Warnings.Append
- ((Start => Loc,
+ ((Start => Node,
Msg => new String'(Msg),
Stop => Source_Last (Get_Source_File_Index (Loc)),
Reason => Reason,
@@ -1680,12 +1682,13 @@ 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 > SWE.Start
+ and then Loc > Start_Loc
and then SWE.Open
- and then Get_Source_File_Index (SWE.Start) =
+ and then Get_Source_File_Index (Start_Loc) =
Get_Source_File_Index (Loc)
then
SWE.Stop := Loc;
@@ -1801,49 +1804,6 @@ package body Erroutc is
return False;
end Sloc_In_Range;
- --------------------------------
- -- Validate_Specific_Warnings --
- --------------------------------
-
- procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc) is
- begin
- if not Warn_On_Warnings_Off then
- return;
- end if;
-
- for J in Specific_Warnings.First .. Specific_Warnings.Last loop
- declare
- SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
-
- begin
- if not SWE.Config then
-
- -- Warn for unmatched Warnings (Off, ...)
-
- if SWE.Open then
- Eproc.all
- ("?.w?pragma Warnings Off with no matching Warnings On",
- SWE.Start);
-
- -- Warn for ineffective Warnings (Off, ..)
-
- elsif not SWE.Used
-
- -- Do not issue this warning for -Wxxx messages since the
- -- back-end doesn't report the information. Note that there
- -- is always an asterisk at the start of every message.
-
- and then not
- (SWE.Msg'Length > 3 and then SWE.Msg (2 .. 3) = "-W")
- then
- Eproc.all
- ("?.w?no warning suppressed by this pragma", SWE.Start);
- end if;
- end if;
- end;
- end loop;
- end Validate_Specific_Warnings;
-
-------------------------------------
-- Warning_Specifically_Suppressed --
-------------------------------------
@@ -1859,13 +1819,13 @@ 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, SWE.Start, SWE.Stop)
+ or else Sloc_In_Range (Loc, Start_Loc, 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 94631093b2c4810bdd8c6490a60597f3ccd2c759..250461f4b5c55b267a60059ed5011ab900398d73 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -347,7 +347,7 @@ package Erroutc is
-- which is the pattern to match for suppressing a warning.
type Specific_Warning_Entry is record
- Start : Source_Ptr;
+ Start : Node_Id;
Stop : Source_Ptr;
-- Starting and ending source pointers for the range. These are always
-- from the same source file.
@@ -651,7 +651,7 @@ package Erroutc is
-- last non-deleted message.
procedure Set_Specific_Warning_Off
- (Loc : Source_Ptr;
+ (Node : Node_Id;
Msg : String;
Reason : String_Id;
Config : Boolean;
@@ -659,13 +659,13 @@ package Erroutc is
-- This is called in response to the two argument form of pragma Warnings
-- where the first argument is OFF, and the second argument is a string
-- which identifies a specific warning to be suppressed. The first argument
- -- is the start of the suppression range, and the second argument is the
- -- string from the pragma. Loc is the location of the pragma (which is the
- -- start of the range to suppress). Reason is the reason string from the
- -- pragma, or the null string if no reason is given. Config is True for the
- -- configuration pragma case (where there is no requirement for a matching
- -- OFF pragma). Used is set True to disable the check that the warning
- -- actually has the effect of suppressing a warning.
+ -- is the corresponding N_Pragma node, and the second argument is the
+ -- string from the pragma. Sloc (Node) is the start of the range to
+ -- suppress. Reason is the reason string from the pragma, or the null
+ -- string if no reason is given. Config is True for the configuration
+ -- pragma case (where there is no requirement for a matching OFF pragma).
+ -- Used is set True to disable the check that the warning actually has the
+ -- effect of suppressing a warning.
procedure Set_Specific_Warning_On
(Loc : Source_Ptr;
@@ -717,11 +717,4 @@ package Erroutc is
-- given by Warning_As_Error pragmas, as stored in the Warnings_As_Errors
-- table.
- type Error_Msg_Proc is
- access procedure (Msg : String; Flag_Location : Source_Ptr);
- procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc);
- -- Checks that specific warnings are consistent (for non-configuration
- -- case, properly closed, and used). The argument is a pointer to the
- -- Error_Msg procedure to be called if any inconsistencies are detected.
-
end Erroutc;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index d7acd4604ded73b00c16d09a47e47db9ae7a79bd..dfc415da3f3442ed0fcfe89a0647edceedd32642 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -27014,7 +27014,7 @@ package body Sem_Prag is
begin
if Chars (Argx) = Name_Off then
Set_Specific_Warning_Off
- (Loc, Message, Reason,
+ (N, Message, Reason,
Config => Is_Configuration_Pragma,
Used => Inside_A_Generic or else In_Instance);