The warning message pattern given for pragma Warning_As_Error or
for pragma Warnings no longer requires leading and trailing asterisks.
The match can be anywhere in the string without these characters
as shown in this example, compiled with -gnatwa -gnatld7 -gnatj55

Compiling: warnmatch.adb

     1. pragma Warnings (Off, "never read");
     2. pragma Warning_As_Error ("useless");
     3. procedure WarnMatch is
     4.    A : Integer;
     5.    B : Integer;
     6. begin
     7.    A := 3;
           |
        >>> error: useless assignment to "A", value
            never referenced [warning-as-error]

     8. end;

 8 lines: No errors, 1 warning (1 treated as errors)

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-07-16  Robert Dewar  <de...@adacore.com>

        * gnat_rm.texi: Document that leading/trailing asterisks are
        now implied for the pattern match string for pragma Warnings
        and Warning_As_Error.
        * sem_prag.adb (Acquire_Warning_Match_String): New procedure.
        (Analyze_Pragma, case Warning_As_Error): Call
        Acquire_Warning_Match_String.
        (Analyze_Pragma, case Warnings): Call Acquire_Warning_Match_String.

Index: gnat_rm.texi
===================================================================
--- gnat_rm.texi        (revision 212650)
+++ gnat_rm.texi        (working copy)
@@ -7328,7 +7328,8 @@
 
 @noindent
 This pragma signals that the entities whose names are listed are
-deliberately not referenced in the current source unit. This
+deliberately not referenced in the current source unit after the
+occurrence of the pragma. This
 suppresses warnings about the
 entities being unreferenced, and in addition a warning will be
 generated if one of these entities is in fact subsequently referenced in the
@@ -7576,12 +7577,16 @@
 
 The pattern may contain asterisks, which match zero or more characters in
 the message. For example, you can use
-@code{pragma Warning_As_Error ("*bits of*unused")} to treat the warning
+@code{pragma Warning_As_Error ("bits of*unused")} to treat the warning
 message @code{warning: 960 bits of "a" unused} as an error. No other regular
 expression notations are permitted. All characters other than asterisk in
 these three specific cases are treated as literal characters in the match.
 The match is case insensitive, for example XYZ matches xyz.
 
+Note that the pattern matches if it occurs anywhere within the warning
+message string (it is not necessary to put an asterisk at the start and
+the end of the message, since this is implied).
+
 Another possibility for the static_string_EXPRESSION which works whether
 or not error tags are enabled (@option{-gnatw.d}) is to use the
 @option{-gnatw} tag string, enclosed in brackets,
@@ -7716,20 +7721,24 @@
 
 The pattern may contain asterisks, which match zero or more characters in
 the message. For example, you can use
-@code{pragma Warnings (Off, "*bits of*unused")} to suppress the warning
+@code{pragma Warnings (Off, "bits of*unused")} to suppress the warning
 message @code{warning: 960 bits of "a" unused}. No other regular
 expression notations are permitted. All characters other than asterisk in
 these three specific cases are treated as literal characters in the match.
 The match is case insensitive, for example XYZ matches xyz.
 
+Note that the pattern matches if it occurs anywhere within the warning
+message string (it is not necessary to put an asterisk at the start and
+the end of the message, since this is implied).
+
 The above use of patterns to match the message applies only to warning
 messages generated by the front end. This form of the pragma with a string
 argument can also be used to control warnings provided by the back end and
 mentioned above. By using a single full @option{-Wxxx} switch in the pragma,
 such warnings can be turned on and off.
 
-There are two ways to use the pragma in this form. The OFF form can be used as 
a
-configuration pragma. The effect is to suppress all warnings (if any)
+There are two ways to use the pragma in this form. The OFF form can be used
+as a configuration pragma. The effect is to suppress all warnings (if any)
 that match the pattern string throughout the compilation (or match the
 -W switch in the back end case).
 
Index: sem_prag.adb
===================================================================
--- sem_prag.adb        (revision 212649)
+++ sem_prag.adb        (working copy)
@@ -2781,6 +2781,16 @@
       type Args_List is array (Natural range <>) of Node_Id;
       --  Types used for arguments to Check_Arg_Order and Gather_Associations
 
+      -----------------------
+      -- Local Subprograms --
+      -----------------------
+
+      procedure Acquire_Warning_Match_String (Arg : Node_Id);
+      --  Used by pragma Warnings (Off, string), and Warn_As_Error (string) to
+      --  get the given string argument, and place it in Name_Buffer, adding
+      --  leading and trailing asterisks if they are not already present. The
+      --  caller has already checked that Arg is a static string expression.
+
       procedure Ada_2005_Pragma;
       --  Called for pragmas defined in Ada 2005, that are not in Ada 95. In
       --  Ada 95 mode, these are implementation defined pragmas, so should be
@@ -3341,9 +3351,34 @@
       procedure Set_Ravenscar_Profile (N : Node_Id);
       --  Activate the set of configuration pragmas and restrictions that make
       --  up the Ravenscar Profile. N is the corresponding pragma node, which
-      --  is used for error messages on any constructs that violate the
-      --  profile.
+      --  is used for error messages on any constructs violating the profile.
 
+      ----------------------------------
+      -- Acquire_Warning_Match_String --
+      ----------------------------------
+
+      procedure Acquire_Warning_Match_String (Arg : Node_Id) is
+      begin
+         String_To_Name_Buffer
+           (Strval (Expr_Value_S (Get_Pragma_Arg (Arg))));
+
+         --  Add asterisk at start if not already there
+
+         if Name_Len > 0 and then Name_Buffer (1) /= '*' then
+            Name_Buffer (2 .. Name_Len + 1) :=
+              Name_Buffer (1 .. Name_Len);
+            Name_Buffer (1) := '*';
+            Name_Len := Name_Len + 1;
+         end if;
+
+         --  Add asterisk at end if not already there
+
+         if Name_Buffer (Name_Len) /= '*' then
+            Name_Len := Name_Len + 1;
+            Name_Buffer (Name_Len) := '*';
+         end if;
+      end Acquire_Warning_Match_String;
+
       ---------------------
       -- Ada_2005_Pragma --
       ---------------------
@@ -21209,8 +21244,7 @@
             --  OK static string expression
 
             else
-               String_To_Name_Buffer
-                 (Strval (Expr_Value_S (Get_Pragma_Arg (Arg1))));
+               Acquire_Warning_Match_String (Arg1);
                Warnings_As_Errors_Count := Warnings_As_Errors_Count + 1;
                Warnings_As_Errors (Warnings_As_Errors_Count) :=
                  new String'(Name_Buffer (1 .. Name_Len));
@@ -21364,7 +21398,7 @@
 
                else
                   Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
-                  Check_At_Most_N_Arguments (2);
+                  Check_Arg_Count (2);
 
                   declare
                      E_Id : Node_Id;
@@ -21438,8 +21472,7 @@
                      --  Static string expression case
 
                      else
-                        String_To_Name_Buffer
-                          (Strval (Expr_Value_S (Get_Pragma_Arg (Arg2))));
+                        Acquire_Warning_Match_String (Arg2);
 
                         --  Note on configuration pragma case: If this is a
                         --  configuration pragma, then for an OFF pragma, we

Reply via email to