Deprecate literal unescaped "{" in regexes.

We are deprecating literal left braces in regular expressions.  The 5.16
delta announced that this is coming.

This commit causes a warning to be raised when a literal "{" is
encountered.  However, it does not do this if the left brace is at the
beginning of a construct.  Such a brace does not cause problems for us
for our future use of it for other purposes, as, for example in things
like \b{w}, and there were a large number of core tests that failed
without this condition.

I didn't mention this exception in the diagnostic.  We may choose to
forbid it everywhere, and we certainly want to discourage its use
everywhere.  But this commit gets the essential components in early in
5.17, and we can tighten it up later if we decide to.

diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index 39bcb3d..21cdf54 100644 (file)
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -186,7 +186,7 @@ use 5.009001;
 use Carp;
 $Carp::Internal{__PACKAGE__.""}++;
 
-our $VERSION = '1.28';
+our $VERSION = '1.29';
 our $DEBUG;
 our $VERBOSE;
 our $PRETTY;
@@ -435,11 +435,11 @@ my %msg;
             }  
             my $lhs = join( '', @toks );
            $transfmt{$header}{pat} =
-              "    s{^$lhs}\n     {\Q$header\E}s\n\t&& return 1;\n";
+              "    s\a^$lhs\a\Q$header\E\as\n\t&& return 1;\n";
             $transfmt{$header}{len} = $conlen;
        } else {
             $transfmt{$header}{pat} =
-             "    m{^\Q$header\E} && return 1;\n";
+             "    m\a^\Q$header\E\a && return 1;\n";
             $transfmt{$header}{len} = length( $header );
        } 
 

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 08d52c7..31ce464 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4928,6 +4928,17 @@ 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
+
+(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
+the pattern delimiters are also braces, any matching right brace
+(C<"}">) should also be escaped to avoid confusing the parser, for
+example,
+
+    qr{abc\{def\}ghi}
+
 =item unexec of %s into %s failed!
 
 (F) The unexec() routine failed for some reason.  See your local FSF

diff --git a/regcomp.c b/regcomp.c
index eefc2cc..9f239ff 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -9077,12 +9077,6 @@ tryagain:
        vFAIL("Internal urp");
                                /* Supposed to be caught earlier. */
        break;
-    case '{':
-       if (!regcurly(RExC_parse)) {
-           RExC_parse++;
-           goto defchar;
-       }
-       /* FALL THROUGH */
     case '?':
     case '+':
     case '*':
@@ -9208,9 +9202,6 @@ tryagain:
            ret = reg_node(pRExC_state, op);
            FLAGS(ret) = get_regex_charset(RExC_flags);
            *flagp |= SIMPLE;
-           if (! SIZE_ONLY && (U8) *(RExC_parse + 1) == '{') {
-               ckWARNregdep(RExC_parse, "\"\\b{\" is deprecated; use \"\\b\\{\" instead");
-           }
            goto finish_meta_pat;
        case 'B':
            RExC_seen_zerolen++;
@@ -9235,9 +9226,6 @@ tryagain:
            ret = reg_node(pRExC_state, op);
            FLAGS(ret) = get_regex_charset(RExC_flags);
            *flagp |= SIMPLE;
-           if (! SIZE_ONLY && (U8) *(RExC_parse + 1) == '{') {
-               ckWARNregdep(RExC_parse, "\"\\B{\" is deprecated; use \"\\B\\{\" instead");
-           }
            goto finish_meta_pat;
        case 's':
            switch (get_regex_charset(RExC_flags)) {
@@ -9744,15 +9732,22 @@ tryagain:
                        /* FALL THROUGH */
                    default:
                        if (!SIZE_ONLY&& isALPHA(*p)) {
-                           /* Include any { following the alpha to emphasize
-                            * that it could be part of an escape at some point
-                            * in the future */
-                           int len = (*(p + 1) == '{') ? 2 : 1;
-                           ckWARN3reg(p + len, "Unrecognized escape \\%.*s passed through", len, p);
+                           ckWARN2reg(p + 1, "Unrecognized escape \\%.1s passed through", p);
                        }
                        goto normal_default;
                    }
                    break;
+               case '{':
+                   /* Currently we don't warn when the lbrace is at the start
+                    * of a construct.  This catches it in the middle of a
+                    * literal string, or when its the first thing after
+                    * something like "\b" */
+                   if (! SIZE_ONLY
+                       && (len || (p > RExC_start && isALPHA_A(*(p -1)))))
+                   {
+                       ckWARNregdep(p + 1, "Unescaped left brace in regex is deprecated, passed through");
+                   }
+                   /*FALLTHROUGH*/
                default:
                  normal_default:
                    if (UTF8_IS_START(*p) && UTF) {

diff --git a/t/comp/parser.t b/t/comp/parser.t
index 16b4a82..a369adb 100644 (file)
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -125,11 +125,11 @@ is( $@, '', 'PL_lex_brackstack' );
     is("${a}[", "A[", "interpolation, qq//");
     my @b=("B");
     is("@{b}{", "B{", "interpolation, qq//");
-    is(qr/${a}{/, '(?^:A{)', "interpolation, qr//");
+    is(qr/${a}\{/, '(?^:A\{)', "interpolation, qr//");
     my $c = "A{";
-    $c =~ /${a}{/;
+    $c =~ /${a}\{/;
     is($&, 'A{', "interpolation, m//");
-    $c =~ s/${a}{/foo/;
+    $c =~ s/${a}\{/foo/;
     is($c, 'foo', "interpolation, s/...//");
     $c =~ s/foo/${a}{/;
     is($c, 'A{', "interpolation, s//.../");

diff --git a/t/io/open.t b/t/io/open.t
index 8066391..6b1f1d7 100644 (file)
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -267,7 +267,7 @@ SKIP: {
 
     open($fh1{k}, "TEST");
     gimme($fh1{k});
-    like($@, qr/<\$fh1{...}> line 1\./, "autoviv fh package helem");
+    like($@, qr/<\$fh1\{...}> line 1\./, "autoviv fh package helem");
 
     my @fh2;
     open($fh2[0], "TEST");
@@ -277,7 +277,7 @@ SKIP: {
     my %fh3;
     open($fh3{k}, "TEST");
     gimme($fh3{k});
-    like($@, qr/<\$fh3{...}> line 1\./, "autoviv fh lexical helem");
+    like($@, qr/<\$fh3\{...}> line 1\./, "autoviv fh lexical helem");
 }
     
 SKIP: {

diff --git a/t/lib/warnings/regcomp b/t/lib/warnings/regcomp
index b435d2a..1a2fb99 100644 (file)
--- a/t/lib/warnings/regcomp
+++ b/t/lib/warnings/regcomp
@@ -57,20 +57,24 @@ Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <--
 use warnings 'regexp';
 "foo" =~ /\q/;
 "foo" =~ /\q{/;
+"foo" =~ /\w{/;
 "foo" =~ /a\b{cde/;
 "foo" =~ /a\B{cde/;
 "bar" =~ /\_/;
 no warnings 'regexp';
 "foo" =~ /\q/;
 "foo" =~ /\q{/;
+"foo" =~ /\w{/;
 "foo" =~ /a\b{cde/;
 "foo" =~ /a\B{cde/;
 "bar" =~ /\_/;
 EXPECT
 Unrecognized escape \q passed through in regex; marked by <-- HERE in m/\q <-- HERE / at - line 4.
-Unrecognized escape \q{ passed through in regex; marked by <-- HERE in m/\q{ <-- HERE / at - line 5.
-"\b{" is deprecated; use "\b\{" instead in regex; marked by <-- HERE in m/a\ <-- HERE b{cde/ at - line 6.
-"\B{" is deprecated; use "\B\{" instead in regex; marked by <-- HERE in m/a\ <-- HERE B{cde/ at - line 7.
+Unrecognized escape \q passed through in regex; marked by <-- HERE in m/\q <-- HERE {/ at - line 5.
+Unescaped left brace in regex is deprecated, passed through in regex; marked by <-- HERE in m/\q{ <-- HERE / at - line 5.
+Unescaped left brace in regex is deprecated, passed through in regex; marked by <-- HERE in m/\w{ <-- HERE / at - line 6.
+Unescaped left brace in regex is deprecated, passed through in regex; marked by <-- HERE in m/a\b{ <-- HERE cde/ at - line 7.
+Unescaped left brace in regex is deprecated, passed through in regex; marked by <-- HERE in m/a\B{ <-- HERE cde/ at - line 8.
 ########
 # regcomp.c [S_regpposixcc S_checkposixcc]
 #

diff --git a/t/op/taint.t b/t/op/taint.t
index 9cea740..a0949d3 100644 (file)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -152,7 +152,7 @@ my $TEST = 'TEST';
        while (my $v = $vars[0]) {
            local $ENV{$v} = $TAINT;
            last if eval { `$echo 1` };
-           last unless $@ =~ /^Insecure \$ENV{$v}/;
+           last unless $@ =~ /^Insecure \$ENV\{$v}/;
            shift @vars;
        }
        is("@vars", "");
@@ -163,7 +163,7 @@ my $TEST = 'TEST';
        is(eval { `$echo 1` }, "1\n");
        $ENV{TERM} = 'e=mc2' . $TAINT;
        is(eval { `$echo 1` }, undef);
-       like($@, qr/^Insecure \$ENV{TERM}/);
+       like($@, qr/^Insecure \$ENV\{TERM}/);
     }
 
     my $tmp;
@@ -182,7 +182,7 @@ my $TEST = 'TEST';
 
        local $ENV{PATH} = $tmp;
        is(eval { `$echo 1` }, undef);
-       like($@, qr/^Insecure directory in \$ENV{PATH}/);
+       like($@, qr/^Insecure directory in \$ENV\{PATH}/);
     }
 
     SKIP: {
@@ -190,14 +190,14 @@ my $TEST = 'TEST';
 
        $ENV{'DCL$PATH'} = $TAINT;
        is(eval { `$echo 1` }, undef);
-       like($@, qr/^Insecure \$ENV{DCL\$PATH}/);
+       like($@, qr/^Insecure \$ENV\{DCL\$PATH}/);
        SKIP: {
             skip q[can't find world-writeable directory to test DCL$PATH], 2
               unless $tmp;
 
            $ENV{'DCL$PATH'} = $tmp;
            is(eval { `$echo 1` }, undef);
-           like($@, qr/^Insecure directory in \$ENV{DCL\$PATH}/);
+           like($@, qr/^Insecure directory in \$ENV\{DCL\$PATH}/);
        }
        $ENV{'DCL$PATH'} = '';
     }
@@ -2112,7 +2112,7 @@ end
     ok("A" =~ /\p{$prop}/, "user-defined property: non-tainted case");
     $prop = "IsA$TAINT";
     eval { "A" =~ /\p{$prop}/};
-    like($@, qr/Insecure user-defined property \\p{main::IsA}/,
+    like($@, qr/Insecure user-defined property \\p\{main::IsA}/,
            "user-defined property: tainted case");
 }
 

diff --git a/t/re/pat.t b/t/re/pat.t
index b34e093..9c29c95 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -152,7 +152,7 @@ sub run_tests {
 
     {
         $_ = 'now is the {time for all} good men to come to.';
-        / {([^}]*)}/;
+        / \{([^}]*)}/;
         is($1, 'time for all', "Match braces");
     }
 

diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index d82fcf1..0d9fbbf 100644 (file)
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -986,7 +986,7 @@ sub run_tests {
         my $w;
         local $SIG {__WARN__} = sub {$w .= "@_"};
         eval 'q(xxWxx) =~ /[\N{WARN}]/';
-        ok $w && $w =~ /Using just the first character returned by \\N{} in character class/,
+        ok $w && $w =~ /Using just the first character returned by \\N\{} in character class/,
                  "single character in [\\N{}] warning";
 
         undef $w;
@@ -1137,6 +1137,7 @@ sub run_tests {
 
     {
         # \, breaks {3,4}
+        no warnings qw{deprecated regexp};
         ok "xaaay"    !~ /xa{3\,4}y/, '\, in a pattern';
         ok "xa{3,4}y" =~ /xa{3\,4}y/, '\, in a pattern';