This patch allows the use of a warning tag as the second parameter of
a pragma Warnings (Off\On, ...) pragma. The effect is to control all
error messages in that category. This tag may be either [-gnatw?] for
a particular category of errors, or [restriction warning] to cover all
restriction warnings, or [enabled by default] to deal with all other
warnings that are set by default.
The following test is compiled with -gnatj55 -gnatl
1. pragma Restriction_Warnings (No_Wide_Characters);
2. package RWarnTag2 is
3. pragma Warnings (Off, "[restriction warning]");
4. Y : Wide_Wide_Character := 'Y';
5. pragma Warnings (On, "[restriction warning]");
6. X : Wide_Wide_Character := 'X';
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 1
7. end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-05-21 Robert Dewar <de...@adacore.com>
* errout.adb, erroutc.adb, erroutc.ads: Allow warning tag in pragma
Warnings (Off, string).
Index: errout.adb
===================================================================
--- errout.adb (revision 210693)
+++ errout.adb (working copy)
@@ -1339,14 +1339,16 @@
Cur := First_Error_Msg;
while Cur /= No_Error_Msg loop
declare
- CE : Error_Msg_Object renames Errors.Table (Cur);
+ CE : Error_Msg_Object renames Errors.Table (Cur);
+ Tag : constant String := Get_Warning_Tag (Cur);
begin
if (CE.Warn and not CE.Deleted)
- and then (Warning_Specifically_Suppressed (CE.Sptr, CE.Text) /=
+ and then
+ (Warning_Specifically_Suppressed (CE.Sptr, CE.Text, Tag) /=
No_String
- or else
- Warning_Specifically_Suppressed (CE.Optr, CE.Text) /=
+ or else
+ Warning_Specifically_Suppressed (CE.Optr, CE.Text, Tag) /=
No_String)
then
Delete_Warning (Cur);
Index: erroutc.adb
===================================================================
--- erroutc.adb (revision 210693)
+++ erroutc.adb (working copy)
@@ -1457,7 +1457,8 @@
function Warning_Specifically_Suppressed
(Loc : Source_Ptr;
- Msg : String_Ptr) return String_Id
+ Msg : String_Ptr;
+ Tag : String) return String_Id
is
begin
-- Loop through specific warning suppression entries
@@ -1473,7 +1474,9 @@
if SWE.Config
or else (SWE.Start <= Loc and then Loc <= SWE.Stop)
then
- if Matches (Msg.all, SWE.Msg.all) then
+ if Matches (Msg.all, SWE.Msg.all)
+ or else Matches (Tag, SWE.Msg.all)
+ then
SWE.Used := True;
return SWE.Reason;
end if;
Index: erroutc.ads
===================================================================
--- erroutc.ads (revision 210693)
+++ erroutc.ads (working copy)
@@ -556,12 +556,14 @@
function Warning_Specifically_Suppressed
(Loc : Source_Ptr;
- Msg : String_Ptr) return String_Id;
+ Msg : String_Ptr;
+ Tag : String) return String_Id;
-- Determines if given message to be posted at given location is suppressed
-- by specific ON/OFF Warnings pragmas specifying this particular message.
-- If the warning is not suppressed then No_String is returned, otherwise
-- the corresponding warning string is returned (or the null string if no
- -- Warning argument was present in the pragma).
+ -- Warning argument was present in the pragma). Tag is the error message
+ -- tag for the message in question.
function Warning_Treated_As_Error (Msg : String) return Boolean;
-- Returns True if the warning message Msg matches any of the strings
