From e2f06df0a8c96f7d9a5f3214fc5bf2daf34588c3 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sat, 6 Aug 2011 07:55:06 +0100
Subject: toke.c: 'Unrecognized character' croak cleanup.

---
 t/uni/parser.t | 10 +++++++++-
 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";
+}
diff --git a/toke.c b/toke.c
index 3a3cddb760..c0a5cdaf09 100644
--- 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:
-- 
cgit v1.2.1