[Ada] Allow warning tag in pragma Warnings (Off, string)

Arnaud Charlet charlet@adacore.com
Wed May 21 12:36:00 GMT 2014


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  <dewar@adacore.com>

	* errout.adb, erroutc.adb, erroutc.ads: Allow warning tag in pragma
	Warnings (Off, string).

-------------- next part --------------
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


More information about the Gcc-patches mailing list