Re: [PATCHES] regcomp.c, pod/perldiag.pod, t/op/pat.t

Message-ID: <Pine.GSO.4.21.0106011032080.21027-100000@crusoe.crusoe.net>

p4raw-id: //depot/perl@10376

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index afcc2cc..17b4b1b 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3706,6 +3706,34 @@ earlier in the line, and you really meant a "less than".
 (W untie) A copy of the object returned from C<tie> (or C<tied>) was
 still valid when C<untie> was called.
 
+=item Useless (?%s) - use /%s modifier in regex; marked by <-- HERE in m/%s/
+
+(W regexp) You have used an internal modifier such as (?o) that has no
+meaning unless applied to the entire regexp:
+
+    if ($string =~ /(?o)$pattern/) { ... }
+
+must be written as
+
+    if ($string =~ /$pattern/o) { ... }
+
+The <-- HERE shows in the regular expression about
+where the problem was discovered. See L<perlre>.
+
+=item Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/
+
+(W regexp) You have used an internal modifier such as (?-o) that has no
+meaning unless removed from the entire regexp:
+
+    if ($string =~ /(?-o)$pattern/o) { ... }
+
+must be written as
+
+    if ($string =~ /$pattern/) { ... }
+
+The <-- HERE shows in the regular expression about
+where the problem was discovered. See L<perlre>.
+
 =item Useless use of %s in void context
 
 (W void) You did something without a side effect in a context that does

diff --git a/regcomp.c b/regcomp.c
index 98cf21b..7a713ae 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -418,6 +418,15 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                 (int)offset, RExC_precomp, RExC_precomp + offset);        \
     } STMT_END
 
+/* used for the parse_flags section for (?c) -- japhy */
+#define        vWARN5(loc, m, a1, a2, a3, a4)                                       \
+  STMT_START {                                                   \
+      unsigned offset = strlen(RExC_precomp)-(RExC_end-(loc));   \
+        Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,      \
+                 a1, a2, a3, a4,                                 \
+                 (int)offset, RExC_precomp, RExC_precomp + offset);  \
+    } STMT_END
+
 
 /* Allow for side effects in s */
 #define REGC(c,s) STMT_START { if (!SIZE_ONLY) *(s) = (c); else (s);} STMT_END
@@ -2018,12 +2027,23 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
     register regnode *ender = 0;
     register I32 parno = 0;
     I32 flags, oregflags = RExC_flags16, have_branch = 0, open = 0;
+
+    /* for (?g), (?gc), and (?o) warnings; warning
+       about (?c) will warn about (?g) -- japhy    */
+
+    I32 wastedflags = 0x00,
+        wasted_o    = 0x01,
+        wasted_g    = 0x02,
+        wasted_gc   = 0x02 | 0x04,
+        wasted_c    = 0x04;
+
     char * parse_start = RExC_parse; /* MJD */
     char *oregcomp_parse = RExC_parse;
     char c;
 
     *flagp = 0;                                /* Tentatively. */
 
+
     /* Make an OPEN node, if parenthesized. */
     if (paren) {
        if (*RExC_parse == '?') { /* (?...) */
@@ -2202,12 +2222,45 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                --RExC_parse;
              parse_flags:      /* (?i) */
                while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) {
-                   if (*RExC_parse != 'o')
-                       pmflag(flagsp, *RExC_parse);
+                   /* (?g), (?gc) and (?o) are useless here
+                      and must be globally applied -- japhy */
+
+                   if (*RExC_parse == 'o' || *RExC_parse == 'g') {
+                       if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
+                           I32 wflagbit = *RExC_parse == 'o' ? wasted_o : wasted_g;
+                           if (! (wastedflags & wflagbit) ) {
+                               wastedflags |= wflagbit;
+                               vWARN5(
+                                   RExC_parse + 1,
+                                   "Useless (%s%c) - %suse /%c modifier",
+                                   flagsp == &negflags ? "?-" : "?",
+                                   *RExC_parse,
+                                   flagsp == &negflags ? "don't " : "",
+                                   *RExC_parse
+                               );
+                           }
+                       }
+                   }
+                   else if (*RExC_parse == 'c') {
+                       if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
+                           if (! (wastedflags & wasted_c) ) {
+                               wastedflags |= wasted_gc;
+                               vWARN3(
+                                   RExC_parse + 1,
+                                   "Useless (%sc) - %suse /gc modifier",
+                                   flagsp == &negflags ? "?-" : "?",
+                                   flagsp == &negflags ? "don't " : ""
+                               );
+                           }
+                       }
+                   }
+                   else { pmflag(flagsp, *RExC_parse); }
+
                    ++RExC_parse;
                }
                if (*RExC_parse == '-') {
                    flagsp = &negflags;
+                   wastedflags = 0;  /* reset so (?g-c) warns twice */
                    ++RExC_parse;
                    goto parse_flags;
                }

diff --git a/t/op/pat.t b/t/op/pat.t
index 0df4d78..ab4226c 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..615\n";
+print "1..625\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -1685,3 +1685,61 @@ EOT
     print "ok 615\n";
 }
 
+{
+    # from japhy
+    my $w;
+    use warnings;    
+    local $SIG{__WARN__} = sub { $w .= shift };
+
+    $w = "";
+    eval 'qr/(?c)/';
+    print "not " if $w !~ /^Useless \(\?c\)/;
+    print "ok 616\n";
+
+    $w = "";
+    eval 'qr/(?-c)/';
+    print "not " if $w !~ /^Useless \(\?-c\)/;
+    print "ok 617\n";
+
+    $w = "";
+    eval 'qr/(?g)/';
+    print "not " if $w !~ /^Useless \(\?g\)/;
+    print "ok 618\n";
+
+    $w = "";
+    eval 'qr/(?-g)/';
+    print "not " if $w !~ /^Useless \(\?-g\)/;
+    print "ok 619\n";
+
+    $w = "";
+    eval 'qr/(?o)/';
+    print "not " if $w !~ /^Useless \(\?o\)/;
+    print "ok 620\n";
+
+    $w = "";
+    eval 'qr/(?-o)/';
+    print "not " if $w !~ /^Useless \(\?-o\)/;
+    print "ok 621\n";
+
+    # now test multi-error regexes
+
+    $w = "";
+    eval 'qr/(?g-o)/';
+    print "not " if $w !~ /^Useless \(\?g\).*\nUseless \(\?-o\)/;
+    print "ok 622\n";
+
+    $w = "";
+    eval 'qr/(?g-c)/';
+    print "not " if $w !~ /^Useless \(\?g\).*\nUseless \(\?-c\)/;
+    print "ok 623\n";
+
+    $w = "";
+    eval 'qr/(?o-cg)/';  # (?c) means (?g) error won't be thrown
+    print "not " if $w !~ /^Useless \(\?o\).*\nUseless \(\?-c\)/;
+    print "ok 624\n";
+
+    $w = "";
+    eval 'qr/(?ogc)/';
+    print "not " if $w !~ /^Useless \(\?o\).*\nUseless \(\?g\).*\nUseless \(\?c\)/;
+    print "ok 625\n";
+}