This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
toke.c: 'Unrecognized character' croak cleanup.
authorBrian Fraser <fraserbn@gmail.com>
Sat, 6 Aug 2011 06:55:06 +0000 (07:55 +0100)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 23 Mar 2012 03:23:52 +0000 (20:23 -0700)
t/uni/parser.t
toke.c

index 42c9520..5b1c37b 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (tests => 37);
+plan (tests => 38);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -100,3 +100,11 @@ our $問 = 10;
 is $問, 10, "our works";
 is $main::問, 10, "...as does getting the same variable through the fully qualified name";
 is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't";
+
+{
+    use charnames qw( :full );
+
+    eval qq! my \$\x{30cb} \N{DROMEDARY CAMEL} !;
+    is $@, 'Unrecognized character \x{1f42a}; marked by <-- HERE after  my $ニ <-- HERE near column 8 at (eval 13) line 1.
+', "'Unrecognized character' croak is UTF-8 clean";
+}
diff --git a/toke.c b/toke.c
index 3a3cddb..c0a5cda 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4765,7 +4765,12 @@ Perl_yylex(pTHX)
        if (isIDFIRST_lazy_if(s,UTF))
            goto keylookup;
        {
-        unsigned char c = *s;
+        SV *dsv = newSVpvs_flags("", SVs_TEMP);
+        const char *c = UTF ? savepv(sv_uni_display(dsv, newSVpvn_flags(s,
+                                                    UTF8SKIP(s),
+                                                    SVs_TEMP | SVf_UTF8),
+                                            10, UNI_DISPLAY_ISPRINT))
+                            : Perl_form(aTHX_ "\\x%02X", (unsigned char)*s);
         len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
         if (len > UNRECOGNIZED_PRECEDE_COUNT) {
             d = UTF ? (char *) Perl_utf8_hop(aTHX_ (U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT) : s - UNRECOGNIZED_PRECEDE_COUNT;
@@ -4773,7 +4778,10 @@ Perl_yylex(pTHX)
             d = PL_linestart;
         }      
         *s = '\0';
-        Perl_croak(aTHX_ "Unrecognized character \\x%02X; marked by <-- HERE after %s<-- HERE near column %d", c, d, (int) len + 1);
+        sv_setpv(dsv, d);
+        if (UTF)
+            SvUTF8_on(dsv);
+        Perl_croak(aTHX_  "Unrecognized character %s; marked by <-- HERE after %"SVf"<-- HERE near column %d", c, SVfARG(dsv), (int) len + 1);
     }
     case 4:
     case 26: