This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Ignore code blocks within /[...]/
authorDavid Mitchell <davem@iabyn.com>
Sat, 17 Sep 2011 11:55:29 +0000 (12:55 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 13 Jun 2012 12:25:49 +0000 (13:25 +0100)
Now that RE code blocks are being handled by the lexer rather than the RE
compiler, make sure that stuff like

    /[(?{]/

isn't mis-interpreted as the start of a code block.

t/re/re_tests
toke.c

index 60b8a34..a66ad9f 100644 (file)
@@ -1546,6 +1546,14 @@ abc\N{def        -       c       -       \\N{NAME} must be resolved by the lexer
 /ff/i  \x{FB01}\x{FB00}        y       $&      \x{FB00}
 /fi/i  \x{FB01}\x{FB00}        y       $&      \x{FB01}
 /fi/i  \x{FB00}\x{FB01}        y       $&      \x{FB01}
+#
+# Make sure we don't see code blocks where there aren't, and vice-versa
+(?#( (?{1+)a   a       y       -       -
+'a# (?{1+'x    a       y       -       -
+ab[(?{1]       ab1     y       -       -
+ab[(?{1\](?{2] ab2     y       -       -
+ab(?{"["})cd   abcd    y       -       -
+ab\[(?{1})c    ab[c    y       -       -
 
 # These test that doesn't cut-off matching too soon in the string for
 # multi-char folds
diff --git a/toke.c b/toke.c
index 3b7ada2..59d3d6b 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2672,6 +2672,7 @@ S_scan_const(pTHX_ char *start)
     register char *d = SvPVX(sv);              /* destination for copies */
     bool dorange = FALSE;                      /* are we in a translit range? */
     bool didrange = FALSE;                     /* did we just finish a range? */
+    bool in_charclass = FALSE;                 /* within /[...]/ */
     bool has_utf8 = FALSE;                     /* Output constant is UTF8 */
     bool  this_utf8 = cBOOL(UTF);              /* Is the source string assumed
                                                   to be UTF8?  But, this can
@@ -2861,6 +2862,12 @@ S_scan_const(pTHX_ char *start)
 
        /* if we get here, we're not doing a transliteration */
 
+       else if (in_charclass && *s == ']' && ! (s>start+1 && s[-1] == '\\'))
+           in_charclass = FALSE;
+
+       else if (PL_lex_inpat && *s == '[')
+           in_charclass = TRUE;
+
        /* skip for regexp comments /(?#comment)/, except for the last
         * char, which will be done separately.
         * Stop on (?{..}) and friends */
@@ -2870,7 +2877,7 @@ S_scan_const(pTHX_ char *start)
                while (s+1 < send && *s != ')')
                    *d++ = NATIVE_TO_NEED(has_utf8,*s++);
            }
-           else if (!PL_lex_casemods &&
+           else if (!PL_lex_casemods && !in_charclass &&
                     (    s[2] == '{' /* This should match regcomp.c */
                      || (s[2] == '?' && s[3] == '{')))
            {