diff options
| author | Brian Fraser <fraserbn@gmail.com> | 2011-08-06 07:55:06 +0100 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2012-03-22 20:23:52 -0700 |
| commit | e2f06df0a8c96f7d9a5f3214fc5bf2daf34588c3 (patch) | |
| tree | a1bc5701968fa0828540eb6221e3b3cbfb798135 | |
| parent | 734ab32188dca45b1704abc89cd0f08809758da3 (diff) | |
| download | perl-e2f06df0a8c96f7d9a5f3214fc5bf2daf34588c3.tar.gz | |
toke.c: 'Unrecognized character' croak cleanup.
| -rw-r--r-- | t/uni/parser.t | 10 | ||||
| -rw-r--r-- | toke.c | 12 |
2 files changed, 19 insertions, 3 deletions
diff --git a/t/uni/parser.t b/t/uni/parser.t index 42c95203c3..5b1c37be3d 100644 --- a/t/uni/parser.t +++ b/t/uni/parser.t @@ -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"; +} @@ -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: |