This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: [perl #126310] single quote UTF-8 malformation detection
authorKarl Williamson <khw@cpan.org>
Fri, 2 Dec 2016 16:35:53 +0000 (09:35 -0700)
committerKarl Williamson <khw@cpan.org>
Fri, 23 Dec 2016 20:21:31 +0000 (13:21 -0700)
This adds UTF-8 wellformedness checking in Perl_lex_next_chunk, which
should get called for all program text, so this makes sure the entire
program is well-formed, not just single- or double-quoted strings.

pod/perldelta.pod
t/lib/warnings/utf8
toke.c

index 312252e..b6feb46 100644 (file)
@@ -343,7 +343,8 @@ files in F<ext/> and F<lib/> are best summarized in L</Modules and Pragmata>.
 
 =item *
 
 
 =item *
 
-XXX
+Under C<use utf8>, the entire Perl program is now checked that the UTF-8
+is wellformed.  This resolves [perl #126310].
 
 =back
 
 
 =back
 
index dded118..3431b86 100644 (file)
@@ -15,6 +15,7 @@
 
 __END__
 # utf8.c [utf8_to_uvchr_buf] -W
 
 __END__
 # utf8.c [utf8_to_uvchr_buf] -W
+# NAME Malformed under 'use utf8' in double-quoted string
 BEGIN {
     if (ord('A') == 193) {
         print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings.";
 BEGIN {
     if (ord('A') == 193) {
         print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings.";
@@ -22,16 +23,25 @@ BEGIN {
     }
 }
 use utf8 ;
     }
 }
 use utf8 ;
+no warnings;    # Malformed is a fatal error, so gets output anyway.
 my $a = "snøstorm" ;
 my $a = "snøstorm" ;
-{
-    no warnings 'utf8' ;
-    my $a = "snøstorm";
-    use warnings 'utf8' ;
-    my $a = "snøstorm";
+EXPECT
+Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 10.
+Malformed UTF-8 character (fatal) at - line 10.
+########
+# NAME Malformed under 'use utf8' in single-quoted string
+BEGIN {
+    if (ord('A') == 193) {
+        print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings.";
+        exit 0;
+    }
 }
 }
+use utf8 ;
+no warnings;    # Malformed is a fatal error, so gets output anyway.
+my $a = 'snøstorm' ;
 EXPECT
 Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 9.
 EXPECT
 Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 9.
-Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 14.
+Malformed UTF-8 character (fatal) at - line 9.
 ########
 use warnings 'utf8';
 my $d7ff  = uc(chr(0xD7FF));
 ########
 use warnings 'utf8';
 my $d7ff  = uc(chr(0xD7FF));
diff --git a/toke.c b/toke.c
index e0a6376..9273425 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1286,6 +1286,8 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
     STRLEN linestart_pos, last_uni_pos, last_lop_pos;
     bool got_some_for_debugger = 0;
     bool got_some;
     STRLEN linestart_pos, last_uni_pos, last_lop_pos;
     bool got_some_for_debugger = 0;
     bool got_some;
+    const U8* first_bad_char_loc;
+
     if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF|LEX_NO_TERM))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
     if (!(flags & LEX_NO_TERM) && PL_lex_inwhat)
     if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF|LEX_NO_TERM))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
     if (!(flags & LEX_NO_TERM) && PL_lex_inwhat)
@@ -1350,6 +1352,19 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
     new_bufend_pos = SvCUR(linestr);
     PL_parser->bufend = buf + new_bufend_pos;
     PL_parser->bufptr = buf + bufptr_pos;
     new_bufend_pos = SvCUR(linestr);
     PL_parser->bufend = buf + new_bufend_pos;
     PL_parser->bufptr = buf + bufptr_pos;
+
+    if (UTF && ! is_utf8_string_loc((U8 *) PL_parser->bufptr,
+                                    PL_parser->bufend - PL_parser->bufptr,
+                                    &first_bad_char_loc))
+    {
+
+        _force_out_malformed_utf8_message(first_bad_char_loc,
+                                          (U8 *) PL_parser->bufend,
+                                          0,
+                                          1 /* 1 means die */ );
+        NOT_REACHED; /* NOTREACHED */
+    }
+
     PL_parser->oldbufptr = buf + oldbufptr_pos;
     PL_parser->oldoldbufptr = buf + oldoldbufptr_pos;
     PL_parser->linestart = buf + linestart_pos;
     PL_parser->oldbufptr = buf + oldbufptr_pos;
     PL_parser->oldoldbufptr = buf + oldoldbufptr_pos;
     PL_parser->linestart = buf + linestart_pos;