Add regcomp.c warning checks to t/porting/diag.t.

 * Support regcomp.c ckWARN and vWARN macros
 * Update pod/perldiag.pod for fixes discovered with new checks
 * Allow t/porting/diag.t to match printfs with flags more liberally

3 files changed, 50 insertions, 21 deletions

diff --git a/lib/diagnostics.t b/lib/diagnostics.t
index 34ea36c6ff..6eecdda0ad 100644
--- a/lib/diagnostics.t
+++ b/lib/diagnostics.t
@@ -107,7 +107,7 @@ like $warning,
 # ; at end of entry in perldiag.pod
 seek STDERR, 0,0;
 $warning = '';
-warn "Perl folding rules are not up-to-date for 0xa; please use the perlbug utility to report;";
+warn "Perl folding rules are not up-to-date for 0xA; please use the perlbug utility to report; in regex; marked by <-- HERE in m/\ <-- HERE q/";
 like $warning,
     qr/regular expression folding rules/s,
     '; works at the end of entries in perldiag.pod';
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 64527f87f0..600436f6c1 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2131,9 +2131,9 @@ about 250 characters for simple names, and somewhat more for compound
 names (like C<$A::B>).  You've exceeded Perl's limits.  Future versions
 of Perl are likely to eliminate these arbitrary limitations.
 
-=item Ignoring zero length \N{} in character class
+=item Ignoring zero length \N{} in character class in regex; marked by <-- HERE in m/%s/
 
-(W) Named Unicode character escapes C<(\N{...})> may return a zero-length
+(W regexp) Named Unicode character escapes C<(\N{...})> may return a zero-length
 sequence.  When such an escape is used in a character class its
 behaviour is not well defined.  Check that the correct escape has
 been used, and the correct charname handler is in scope.
@@ -3826,10 +3826,10 @@ redirected it with select().)
 "Can't locate object method \"%s\" via package \"%s\"".  It often means
 that a method requires a package that has not been loaded.
 
-=item Perl folding rules are not up-to-date for 0x%x; please use the perlbug 
-utility to report;
+=item Perl folding rules are not up-to-date for 0x%X; please use the perlbug 
+utility to report; in regex; marked by <-- HERE in m/%s/
 
-(W regex, deprecated) You used a regular expression with
+(W regexp, deprecated) You used a regular expression with
 case-insensitive matching, and there is a bug in Perl in which the
 built-in regular expression folding rules are not accurate.  This may
 lead to incorrect results.  Please report this as a bug using the
@@ -3926,7 +3926,7 @@ not C<isprint>.  See L<perlre>.
 (F) Your system has POSIX getpgrp(), which takes no argument, unlike
 the BSD version, which takes a pid.
 
-=item POSIX syntax [%s] belongs inside character classes in regex; marked by 
+=item POSIX syntax [%c %c] belongs inside character classes in regex; marked by 
 <-- HERE in m/%s/
 
 (W regexp) The character class constructs [: :], [= =], and [. .]  go
@@ -4129,8 +4129,8 @@ expression the problem was discovered.  See L<perlre>.
 the {min,max} construct.  The <-- HERE shows whereabouts in the regular
 expression the problem was discovered.  See L<perlre>.
 
-=item Quantifier unexpected on zero-length expression; marked by <-- HERE in 
-m/%s/
+=item Quantifier unexpected on zero-length expression in regex; marked by <-- 
+HERE in m/%s/
 
 (W regexp) You applied a regular expression quantifier in a place where
 it makes no sense, such as on a zero-width assertion.  Try putting the
@@ -4141,7 +4141,7 @@ C</abc(?=(?:xyz){3})/>, not C</abc(?=xyz){3}/>.
 The <-- HERE shows whereabouts in the regular expression the problem was
 discovered.
 
-=item Quantifier {n,m} with n > m can't match in regex
+=item Quantifier {n,m} with n > m can't match in regex; marked by <-- HERE in m/%s/
 
 (W regexp) Minima should be less than or equal to maxima.  If you really
 want your regexp to match something 0 times, just put {0}.
@@ -5068,11 +5068,12 @@ C<undef *foo>.
 (A) You've accidentally run your script through B<csh> instead of Perl.
 Check the #! line, or manually feed your script into Perl yourself.
 
-=item Unescaped left brace in regex is deprecated, passed through
+=item Unescaped left brace in regex is deprecated, passed through in regex; 
+marked by <-- HERE in m/%s/
 
-(D) You used a literal C<"{"> character in a regular expression pattern.
-You should change to use C<"\{"> instead, because a future version of
-Perl (tentatively v5.20) will consider this to be a syntax error.  If
+(D deprecated, regexp) You used a literal C<"{"> character in a regular 
+expression pattern. You should change to use C<"\{"> instead, because a future 
+version of Perl (tentatively v5.20) will consider this to be a syntax error.  If
 the pattern delimiters are also braces, any matching right brace
 (C<"}">) should also be escaped to avoid confusing the parser, for
 example,
diff --git a/t/porting/diag.t b/t/porting/diag.t
index c6071c587a..047bf8f56c 100644
--- a/t/porting/diag.t
+++ b/t/porting/diag.t
@@ -51,6 +51,7 @@ while (<$func_fh>) {
 
 close $func_fh;
 
+my $regcomp_re = "(?<routine>(?:ckWARN(?:\\d+)?reg\\w*|vWARN\\d+))";
 my $function_re = join '|', @functions;
 my $regcomp_fail_re = '\b(?:(?:Simple_)?v)?FAIL[2-4]?\b';
 my $source_msg_re =
@@ -62,6 +63,7 @@ my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s*
     $text_re /x;
 my $bad_version_re = qr{BADVERSION\([^"]*$text_re};
    $regcomp_fail_re = qr/$regcomp_fail_re\([^"]*$text_re/;
+my $regcomp_call_re = qr/$regcomp_re.*?$text_re/;
 
 my %entries;
 
@@ -249,7 +251,7 @@ sub check_file {
 
     my $multiline = 0;
     # Loop to accumulate the message text all on one line.
-    if (m/$source_msg_re(?:_nocontext)?\s*\(/) {
+    if (m/(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\(/) {
       while (not m/\);$/) {
         my $nextline = <$codefh>;
         # Means we fell off the end of the file.  Not terribly surprising;
@@ -280,9 +282,9 @@ sub check_file {
     # The %"foo" thing needs to happen *before* this regex.
     # diag($_);
     # DIE is just return Perl_die
-    my ($name, $category);
+    my ($name, $category, $routine);
     if (/$source_msg_call_re/) {
-      ($name, $category) = ($+{'text'}, $+{'category'});
+      ($name, $category, $routine) = ($+{'text'}, $+{'category'}, $+{'routine'});
       # Sometimes the regexp will pick up too much for the category
       # e.g., WARN_UNINITIALIZED), PL_warn_uninit_sv ... up to the next )
       $category && $category =~ s/\).*//s;
@@ -297,14 +299,25 @@ sub check_file {
       $name .=
         " in regex" . ("; marked by <-- HERE in" x /vFAIL/) . " m/%s/";
     }
+    elsif (/$regcomp_call_re/) {
+      # vWARN/ckWARNreg("foo") -> "foo in regex; marked by <-- HERE in m/%s/
+      ($name, $category, $routine) = ($+{'text'}, undef, $+{'routine'});
+      $name .= " in regex; marked by <-- HERE in m/%s/";
+      $category = 'WARN_REGEXP';
+      if ($routine =~ /dep/) {
+        $category .= ',WARN_DEPRECATED';
+      }
+    }
     else {
       next;
     }
 
-    my $severity = !$+{routine}                 ? '[PFX]'
-                 :  $+{routine} =~ /warn.*_d\z/ ? '[DS]'
-                 :  $+{routine} =~ /warn/       ? '[WDS]'
-                 :                                '[PFX]';
+    my $severity = !$routine                   ? '[PFX]'
+                 :  $routine =~ /warn.*_d\z/   ? '[DS]'
+                 :  $routine =~ /warn/         ? '[WDS]'
+                 :  $routine =~ /ckWARN\d*reg/ ? '[WDS]'
+                 :  $routine =~ /vWARN\d/      ? '[WDS]'
+                 :                             '[PFX]';
     my $categories;
     if (defined $category) {
       $category =~ s/__/::/g;
@@ -350,6 +363,18 @@ sub check_message {
     my $key = $name =~ y/\n/ /r;
     my $ret;
 
+    # Try to reduce printf() formats to simplest forms
+    # Really this should be matching %s, etc like diagnostics.pm does
+
+    # Kill flags
+    $key =~ s/%[#0\-+]/%/g;
+
+    # Kill width
+    $key =~ s/\%(\d+|\*)/%/g;
+
+    # Kill precision
+    $key =~ s/\%\.(\d+|\*)/%/g;
+
     if (exists $entries{$key}) {
       $ret = 1;
       if ( $entries{$key}{seen}++ ) {
@@ -603,6 +628,9 @@ Within []-length '%c' not allowed in %s
 Wrong syntax (suid) fd script name "%s"
 'X' outside of string in %s
 'X' outside of string in unpack
+Useless (%s%c) - %suse /%c modifier in regex; marked by <-- HERE in m/%s/
+Useless (%sc) - %suse /gc modifier in regex; marked by <-- HERE in m/%s/
+Useless use of (?-p) in regex; marked by <-- HERE in m/%s/
 
 __CATEGORIES__
 Code point 0x%X is not Unicode, all \p{} matches fail; all \P{} matches succeed