This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
toke.c: Make new error UTF-8 safe
authorBrian Fraser <fraserbn@gmail.com>
Tue, 19 Jun 2012 20:05:18 +0000 (17:05 -0300)
committerKarl Williamson <public@khwilliamson.com>
Thu, 21 Jun 2012 15:48:05 +0000 (09:48 -0600)
Commit 0da72d5e623b55d88fb3772b9c91e8f2d1ea7c40 introduced a new error
message, but did not account for UTF-8 source.

t/lib/warnings/toke
toke.c

index db4bbee..2a34811 100644 (file)
@@ -163,6 +163,21 @@ Unknown regexp modifier "/q" at - line 3, near "=~ "
 Execution of - aborted due to compilation errors.
 ########
 # toke.c
+use utf8;
+use open qw( :utf8 :std );
+$a =~ m/$foo/eネq;
+$a =~ s/$foo/fool/seネq;
+
+EXPECT
+OPTION fatal
+Unknown regexp modifier "/e" at - line 4, near "=~ "
+Unknown regexp modifier "/ネ" at - line 4, near "=~ "
+Unknown regexp modifier "/q" at - line 4, near "=~ "
+Unknown regexp modifier "/ネ" at - line 5, near "=~ "
+Unknown regexp modifier "/q" at - line 5, near "=~ "
+Execution of - aborted due to compilation errors.
+########
+# toke.c
 use warnings 'syntax' ;
 s/(abc)/\1/;
 no warnings 'syntax' ;
diff --git a/toke.c b/toke.c
index 99c1e22..6d28ec0 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -9056,11 +9056,13 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse
      * to allow only one */
 
     const char c = **s;
+    STRLEN charlen = UTF ? UTF8SKIP(*s) : 1;
 
-    if (! strchr(valid_flags, c)) {
-        if (isALNUM(c)) {
-           yyerror(Perl_form(aTHX_ "Unknown regexp modifier \"/%c\"", c));
-            (*s)++;
+    if ( charlen != 1 || ! strchr(valid_flags, c) ) {
+        if (isALNUM_lazy_if(*s, UTF)) {
+            yyerror_pv(Perl_form(aTHX_ "Unknown regexp modifier \"/%.*s\"", charlen, *s),
+                       UTF ? SVf_UTF8 : 0);
+            (*s) += charlen;
             return TRUE;
         }
         return FALSE;