Deprecate multiple "x" in "/xx"

 It is planned for a future Perl release to have /xx mean something
 different from just /x.  To prepare for this, this commit raises a
 deprecation warning if someone currently has this usage.  A grep of CPAN
 did not turn up any instances of this, but this is to be safe anyway.

 The added code is more general than actually needed, in case we want to
 do this for another flag.

diff --git a/ext/re/re.pm b/ext/re/re.pm
index 5904d4e..511c1c4 100644 (file)
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -109,6 +109,7 @@ sub _load_unload {
 sub bits {
     my $on = shift;
     my $bits = 0;
+    my %seen;   # Has flag already been seen?
    ARG:
     foreach my $idx (0..$#_){
         my $s=$_[$idx];
@@ -187,7 +188,8 @@ sub bits {
                          && $^H{reflags_charset} == $reflags{$_};
                    }
                } elsif (exists $reflags{$_}) {
-                   $on
+                    $seen{$_}++;
+                    $on
                      ? $reflags |= $reflags{$_}
                      : ($reflags &= ~$reflags{$_});
                } else {
@@ -208,6 +210,18 @@ sub bits {
                        ")");
        }
     }
+    if (exists $seen{'x'} && $seen{'x'} > 1
+        && (warnings::enabled("deprecated")
+            || warnings::enabled("regexp")))
+    {
+        my $message = "Having more than one /x regexp modifier is deprecated";
+        if (warnings::enabled("deprecated")) {
+            warnings::warn("deprecated", $message);
+        }
+        else {
+            warnings::warn("regexp", $message);
+        }
+    }
     $bits;
 }
 

diff --git a/ext/re/t/reflags.t b/ext/re/t/reflags.t
index b2cbf80..e90a712 100644 (file)
--- a/ext/re/t/reflags.t
+++ b/ext/re/t/reflags.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 62;
+use Test::More tests => 63;
 
 my @flags = qw( a d l u );
 
@@ -165,9 +165,13 @@ is qr//, '(?^:)', 'no re "/aai"';
   }
 
   $w = "";
-  eval "use re '/axaa'";
+  eval "use re '/amaa'";
   like $w, qr/The "a" flag may only appear a maximum of twice/,
-    "warning with eval \"use re \"/axaa\"";
+    "warning with eval \"use re \"/amaa\"";
 
+  $w = "";
+  eval "use re '/xamax'";
+  like $w, qr/Having more than one \/x regexp modifier is deprecated/,
+    "warning with eval \"use re \"/xamax\"";
 
 }

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index a6d28f4..4ea0a09 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -94,7 +94,20 @@ as an updated module in the L</Modules and Pragmata> section.
 
 =back
 
-[ List each other deprecation as a =head2 entry ]
+=head2 Use of multiple /x regexp modifiers
+
+It is now deprecated to say something like any of the following:
+
+    qr/foo/xx;
+    /(?xax:foo)/;
+    use re qw(/amxx);
+
+That is, now C<x> should only occur once in any string of contiguous
+regular expression pattern modifiers.  We do not believe there are any
+occurrences of this in all of CPAN.  This is in preparation for a future
+Perl release having C</xx> mean to allow white-space for readability in
+bracketed character classes (those enclosed in square brackets:
+C<[...]>).
 
 =head1 Performance Enhancements
 

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index abfa50d..b4559ce 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2207,6 +2207,13 @@ created on an emergency basis to prevent a core dump.
 (F) The parser has given up trying to parse the program after 10 errors.
 Further error messages would likely be uninformative.
 
+=item Having more than one /%c regexp modifier is deprecated
+
+(D deprecated, regexp) You used the indicated regular expression pattern
+modifier at least twice in a string of modifiers.  It is deprecated to
+do this with this particular modifier, to allow future extensions to the
+Perl language.
+
 =item Hexadecimal float: exponent overflow
 
 (W overflow) The hexadecimal floating point has a larger exponent

diff --git a/regcomp.c b/regcomp.c
index 33971f4..27061b0 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -9324,6 +9324,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state)
     regex_charset cs;
     bool has_use_defaults = FALSE;
     const char* const seqstart = RExC_parse - 1; /* Point to the '?' */
+    int x_mod_count = 0;
 
     PERL_ARGS_ASSERT_PARSE_LPAREN_QUESTION_FLAGS;
 
@@ -9351,7 +9352,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state)
         switch (*RExC_parse) {
 
             /* Code for the imsx flags */
-            CASE_STD_PMMOD_FLAGS_PARSE_SET(flagsp);
+            CASE_STD_PMMOD_FLAGS_PARSE_SET(flagsp, x_mod_count);
 
             case LOCALE_PAT_MOD:
                 if (has_charset_modifier) {
@@ -9488,6 +9489,9 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state)
                 if (RExC_flags & RXf_PMf_FOLD) {
                     RExC_contains_i = 1;
                 }
+                if (PASS2) {
+                    STD_PMMOD_FLAGS_PARSE_X_WARN(x_mod_count);
+                }
                 return;
                 /*NOTREACHED*/
             default:
@@ -9501,6 +9505,10 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state)
 
         ++RExC_parse;
     }
+
+    if (PASS2) {
+        STD_PMMOD_FLAGS_PARSE_X_WARN(x_mod_count);
+    }
 }
 
 /*

diff --git a/regexp.h b/regexp.h
index 1f6b67d..7622d67 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -274,11 +274,18 @@ and check for NULL.
 
 #define RXf_PMf_STD_PMMOD      (RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_FOLD|RXf_PMf_EXTENDED)
 
-#define CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl)                        \
-    case IGNORE_PAT_MOD:    *(pmfl) |= RXf_PMf_FOLD;       break;   \
-    case MULTILINE_PAT_MOD: *(pmfl) |= RXf_PMf_MULTILINE;  break;   \
-    case SINGLE_PAT_MOD:    *(pmfl) |= RXf_PMf_SINGLELINE; break;   \
-    case XTENDED_PAT_MOD:   *(pmfl) |= RXf_PMf_EXTENDED;   break
+#define CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl, x_count)                       \
+    case IGNORE_PAT_MOD:    *(pmfl) |= RXf_PMf_FOLD;       break;           \
+    case MULTILINE_PAT_MOD: *(pmfl) |= RXf_PMf_MULTILINE;  break;           \
+    case SINGLE_PAT_MOD:    *(pmfl) |= RXf_PMf_SINGLELINE; break;           \
+    case XTENDED_PAT_MOD:   *(pmfl) |= RXf_PMf_EXTENDED; (x_count)++; break;
+
+#define STD_PMMOD_FLAGS_PARSE_X_WARN(x_count)                                   \
+    if (UNLIKELY((x_count) > 1)) {                                              \
+        Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP),         \
+                    "Having more than one /%c regexp modifier is deprecated",   \
+                    XTENDED_PAT_MOD);                                           \
+    }
 
 /* Note, includes charset ones, assumes 0 is the default for them */
 #define STD_PMMOD_FLAGS_CLEAR(pmfl)                        \

diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index 347234f..5162aac 100644 (file)
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -439,6 +439,10 @@ my @deprecated = (
                  'Unescaped left brace in regex is deprecated, passed through {#} m/\q{{#}/'
                ],
     '/:{4,a}/' => 'Unescaped left brace in regex is deprecated, passed through {#} m/:{{#}4,a}/',
+    '/abc/xix' => 'Having more than one /x regexp modifier is deprecated',
+    '/(?xmsixp:abc)/' => 'Having more than one /x regexp modifier is deprecated',
+    '/(?xmsixp)abc/' => 'Having more than one /x regexp modifier is deprecated',
+    '/(?xxxx:abc)/' => 'Having more than one /x regexp modifier is deprecated',
 );
 
 while (my ($regex, $expect) = splice @death, 0, 2) {

diff --git a/toke.c b/toke.c
index 646d9d2..33a68c6 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -8668,7 +8668,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
 }
 
 static bool
-S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charset) {
+S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charset, unsigned int * x_mod_count) {
 
     /* Adds, subtracts to/from 'pmfl' based on the next regex modifier flag
      * found in the parse starting at 's', based on the subset that are valid
@@ -8697,7 +8697,7 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse
 
     switch (c) {
 
-        CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl);
+        CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl, *x_mod_count);
         case GLOBAL_PAT_MOD:      *pmfl |= PMf_GLOBAL; break;
         case CONTINUE_PAT_MOD:    *pmfl |= PMf_CONTINUE; break;
         case ONCE_PAT_MOD:        *pmfl |= PMf_KEEP; break;
@@ -8772,6 +8772,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
     const char * const valid_flags =
        (const char *)((type == OP_QR) ? QR_PAT_MODS : M_PAT_MODS);
     char charset = '\0';    /* character set modifier */
+    unsigned int x_mod_count = 0;
 
     PERL_ARGS_ASSERT_SCAN_PAT;
 
@@ -8821,7 +8822,9 @@ S_scan_pat(pTHX_ char *start, I32 type)
        pm->op_pmflags |= PMf_IS_QR;
     }
 
-    while (*s && S_pmflag(aTHX_ valid_flags, &(pm->op_pmflags), &s, &charset)) {};
+    while (*s && S_pmflag(aTHX_ valid_flags, &(pm->op_pmflags),
+                                &s, &charset, &x_mod_count))
+    {};
     /* issue a warning if /c is specified,but /g is not */
     if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL))
     {
@@ -8829,6 +8832,8 @@ S_scan_pat(pTHX_ char *start, I32 type)
                       "Use of /c modifier is meaningless without /g" );
     }
 
+    STD_PMMOD_FLAGS_PARSE_X_WARN(x_mod_count);
+
     PL_lex_op = (OP*)pm;
     pl_yylval.ival = OP_MATCH;
     return s;
@@ -8843,6 +8848,7 @@ S_scan_subst(pTHX_ char *start)
     line_t first_line;
     I32 es = 0;
     char charset = '\0';    /* character set modifier */
+    unsigned int x_mod_count = 0;
     char *t;
 
     PERL_ARGS_ASSERT_SCAN_SUBST;
@@ -8876,12 +8882,15 @@ S_scan_subst(pTHX_ char *start)
            s++;
            es++;
        }
-       else if (! S_pmflag(aTHX_ S_PAT_MODS, &(pm->op_pmflags), &s, &charset))
+       else if (! S_pmflag(aTHX_ S_PAT_MODS, &(pm->op_pmflags),
+                                  &s, &charset, &x_mod_count))
        {
            break;
        }
     }
 
+    STD_PMMOD_FLAGS_PARSE_X_WARN(x_mod_count);
+
     if ((pm->op_pmflags & PMf_CONTINUE)) {
         Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" );
     }