PATCH: [perl #133992] Assertion failure in scan_const

I haven't done the digging, but this appears to be a failure to include
UTF-8 processing when 'use utf8' was added to Perl.

The code that was causing this in toke.c had found a qr/(?#... beginning
of comment in a pattern.  It attempted to space up to but not including
the final character, which is handled later.  (In most instances that
final character is a single-byte ')', but not in this test case.  It
spaced per-byte.  The problem is that if the final character is in UTF-8
and isn't a single byte, it leaves the input position pointing at the
final byte of that character, which creates malformed UTF-8, which the
assertion discovered.

The fix is to be cognizant that this is UTF-8 when spacing to the end,
so that the final position begins at the first byte of it.

diff --git a/t/re/pat.t b/t/re/pat.t
index 5d4bdb1..e54affc 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -25,7 +25,7 @@ BEGIN {
 skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
 skip_all_without_unicode_tables();
 
-plan tests => 862;  # Update this when adding/deleting tests.
+plan tests => 863;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -2095,6 +2095,16 @@ x{0c!}\;\;îçÿ \0\7f/0f/!\0F\ 5\0\0/;îçÿù\Q\0\ 1\0\0x\10ÿÿÿÿ\0\0\0ù\0\0\0\7f`x{0c!}\ 1;\0\0\0ù\Q
                       '[^0] doesnt crash on UTF-8 target string');
     }
 
+    {   # [perl #133992]  This is a tokenizer bug of parsing a pattern
+        fresh_perl_is(q:$z = do {
+                                use utf8;
+                                "q!Ñ\82еÑ\81Ñ\82! =~ m'"
+                        };
+                        $z .= 'è(?#\84';
+                        $z .= "'";
+                        eval $z;:, "", {}, 'foo');
+    }
+
 } # End of sub run_tests
 
 1;

diff --git a/toke.c b/toke.c
index 3add418..c87cf1c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3399,8 +3399,19 @@ S_scan_const(pTHX_ char *start)
              * friends */
        else if (*s == '(' && PL_lex_inpat && s[1] == '?' && !in_charclass) {
            if (s[2] == '#') {
-               while (s+1 < send && *s != ')')
-                   *d++ = *s++;
+                if (s_is_utf8) {
+                    PERL_UINT_FAST8_T  len = UTF8SKIP(s);
+
+                    while (s + len < send && *s != ')') {
+                        Copy(s, d, len, U8);
+                        d += len;
+                        s += len;
+                        len = UTF8_SAFE_SKIP(s, send);
+                    }
+                }
+                else while (s+1 < send && *s != ')') {
+                    *d++ = *s++;
+                }
            }
            else if (!PL_lex_casemods
                      && (    s[2] == '{' /* This should match regcomp.c */