From 19c6248174a2dd57782271308b166ab6bc3e63c8 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Fri, 5 Aug 2011 15:46:14 -0300
Subject: toke.c: yyerror cleanup.

---
 embed.fnc |  5 ++++-
 embed.h   |  5 ++++-
 proto.h   | 17 ++++++++++++++++-
 toke.c    | 58 +++++++++++++++++++++++++++++++++++++++++++---------------
 4 files changed, 67 insertions(+), 18 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index f9d214d266..e01d915b15 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1514,6 +1514,9 @@ Ap     |I32    |whichsig_pvn   |NN const char* sig|STRLEN len
 p	|void	|write_to_stderr|NN SV* msv
 : Used in op.c
 p	|int	|yyerror	|NN const char *const s
+p	|int	|yyerror_pv	|NN const char *const s|U32 flags
+p	|int	|yyerror_pvn	|NN const char *const s|STRLEN len|U32 flags
+p	|int	|yyerror_sv	|NN SV * sv|U32 flags
 : Used in perly.y, and by Data::Alias
 EXp	|int	|yylex
 p	|void	|yyunlex
@@ -1522,7 +1525,7 @@ p	|int	|yyparse	|int gramtype
 : Only used in scope.c
 p	|void	|parser_free	|NN const yy_parser *parser
 #if defined(PERL_IN_TOKE_C)
-s	|int	|yywarn		|NN const char *const s
+s	|int	|yywarn		|NN const char *const s|U32 flags
 #endif
 #if defined(MYMALLOC)
 Ap	|void	|dump_mstats	|NN const char* s
diff --git a/embed.h b/embed.h
index 31e024c4bf..01505700ec 100644
--- a/embed.h
+++ b/embed.h
@@ -1212,6 +1212,9 @@
 #define watch(a)		Perl_watch(aTHX_ a)
 #define write_to_stderr(a)	Perl_write_to_stderr(aTHX_ a)
 #define yyerror(a)		Perl_yyerror(aTHX_ a)
+#define yyerror_pv(a,b)		Perl_yyerror_pv(aTHX_ a,b)
+#define yyerror_pvn(a,b,c)	Perl_yyerror_pvn(aTHX_ a,b,c)
+#define yyerror_sv(a,b)		Perl_yyerror_sv(aTHX_ a,b)
 #define yyparse(a)		Perl_yyparse(aTHX_ a)
 #define yyunlex()		Perl_yyunlex(aTHX)
 #  if !(defined(DEBUGGING))
@@ -1594,7 +1597,7 @@
 #define tokenize_use(a,b)	S_tokenize_use(aTHX_ a,b)
 #define tokeq(a)		S_tokeq(aTHX_ a)
 #define update_debugger_info(a,b,c)	S_update_debugger_info(aTHX_ a,b,c)
-#define yywarn(a)		S_yywarn(aTHX_ a)
+#define yywarn(a,b)		S_yywarn(aTHX_ a,b)
 #    if defined(PERL_MAD)
 #define curmad(a,b)		S_curmad(aTHX_ a,b)
 #define skipspace0(a)		S_skipspace0(aTHX_ a)
diff --git a/proto.h b/proto.h
index d8978c6c9f..c9b51e9f69 100644
--- a/proto.h
+++ b/proto.h
@@ -4769,6 +4769,21 @@ PERL_CALLCONV int	Perl_yyerror(pTHX_ const char *const s)
 #define PERL_ARGS_ASSERT_YYERROR	\
 	assert(s)
 
+PERL_CALLCONV int	Perl_yyerror_pv(pTHX_ const char *const s, U32 flags)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_YYERROR_PV	\
+	assert(s)
+
+PERL_CALLCONV int	Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_YYERROR_PVN	\
+	assert(s)
+
+PERL_CALLCONV int	Perl_yyerror_sv(pTHX_ SV * sv, U32 flags)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_YYERROR_SV	\
+	assert(sv)
+
 PERL_CALLCONV int	Perl_yylex(pTHX);
 PERL_CALLCONV int	Perl_yyparse(pTHX_ int gramtype);
 PERL_CALLCONV void	Perl_yyunlex(pTHX);
@@ -7104,7 +7119,7 @@ STATIC SV*	S_tokeq(pTHX_ SV *sv)
 	assert(sv)
 
 STATIC void	S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len);
-STATIC int	S_yywarn(pTHX_ const char *const s)
+STATIC int	S_yywarn(pTHX_ const char *const s, U32 flags)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_YYWARN	\
 	assert(s)
diff --git a/toke.c b/toke.c
index 58142ab414..08607efb25 100644
--- a/toke.c
+++ b/toke.c
@@ -537,7 +537,7 @@ S_no_op(pTHX_ const char *const what, char *s)
 	s = oldbp;
     else
 	PL_bufptr = s;
-    yywarn(Perl_form(aTHX_ "%s found where operator expected", what));
+    yywarn(Perl_form(aTHX_ "%s found where operator expected", what), 0);
     if (ckWARN_d(WARN_SYNTAX)) {
 	if (is_first)
 	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
@@ -10713,32 +10713,59 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 #pragma segment Perl_yylex
 #endif
 static int
-S_yywarn(pTHX_ const char *const s)
+S_yywarn(pTHX_ const char *const s, U32 flags)
 {
     dVAR;
 
     PERL_ARGS_ASSERT_YYWARN;
 
     PL_in_eval |= EVAL_WARNONLY;
-    yyerror(s);
+    yyerror_pv(s, flags);
     PL_in_eval &= ~EVAL_WARNONLY;
     return 0;
 }
 
 int
 Perl_yyerror(pTHX_ const char *const s)
+{
+    PERL_ARGS_ASSERT_YYERROR;
+    return yyerror_pvn(s, strlen(s), 0);
+}
+
+int
+Perl_yyerror_pv(pTHX_ const char *const s, U32 flags)
+{
+    PERL_ARGS_ASSERT_YYERROR_PV;
+    return yyerror_pvn(s, strlen(s), flags);
+}
+
+int
+Perl_yyerror_sv(pTHX_ SV * sv, U32 flags)
+{
+    char *s;
+    STRLEN len;
+    PERL_ARGS_ASSERT_YYERROR_SV;
+    s = SvPV(sv, len);
+    if (SvUTF8(sv))
+       flags |= SVf_UTF8;
+    return yyerror_pvn(s, len, flags);
+}
+
+int
+Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
 {
     dVAR;
-    const char *where = NULL;
     const char *context = NULL;
     int contlen = -1;
     SV *msg;
+    SV * const where_sv = newSVpvs_flags("", SVs_TEMP);
     int yychar  = PL_parser->yychar;
+    U32 is_utf8 = flags & SVf_UTF8;
 
-    PERL_ARGS_ASSERT_YYERROR;
+    PERL_ARGS_ASSERT_YYERROR_PVN;
 
     if (!yychar || (yychar == ';' && !PL_rsfp))
-	where = "at EOF";
+	sv_catpvs(where_sv, "at EOF");
     else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr &&
       PL_bufptr - PL_oldoldbufptr < 200 && PL_oldoldbufptr != PL_oldbufptr &&
       PL_oldbufptr != PL_bufptr) {
@@ -10773,18 +10800,18 @@ Perl_yyerror(pTHX_ const char *const s)
 	contlen = PL_bufptr - PL_oldbufptr;
     }
     else if (yychar > 255)
-	where = "next token ???";
+	sv_catpvs(where_sv, "next token ???");
     else if (yychar == -2) { /* YYEMPTY */
 	if (PL_lex_state == LEX_NORMAL ||
 	   (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
-	    where = "at end of line";
+	    sv_catpvs(where_sv, "at end of line");
 	else if (PL_lex_inpat)
-	    where = "within pattern";
+	    sv_catpvs(where_sv, "within pattern");
 	else
-	    where = "within string";
+	    sv_catpvs(where_sv, "within string");
     }
     else {
-	SV * const where_sv = newSVpvs_flags("next char ", SVs_TEMP);
+	sv_catpvs(where_sv, "next char ");
 	if (yychar < 32)
 	    Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
 	else if (isPRINT_LC(yychar)) {
@@ -10793,15 +10820,16 @@ Perl_yyerror(pTHX_ const char *const s)
 	}
 	else
 	    Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
-	where = SvPVX_const(where_sv);
     }
-    msg = sv_2mortal(newSVpv(s, 0));
+    msg = sv_2mortal(newSVpvn_flags(s, len, is_utf8));
     Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
         OutCopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
     if (context)
-	Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
+	Perl_sv_catpvf(aTHX_ msg, "near \"%"SVf"\"\n",
+                            SVfARG(newSVpvn_flags(context, contlen,
+                                        SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
     else
-	Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
+	Perl_sv_catpvf(aTHX_ msg, "%"SVf"\n", SVfARG(where_sv));
     if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) {
         Perl_sv_catpvf(aTHX_ msg,
         "  (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
-- 
cgit v1.2.1


From 7350962f469ccd5aa91df76014fab15c0a785530 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 21 Mar 2012 17:55:19 -0700
Subject: Remove yyerror_sv

This was added in the previous commit, but was unnecessary, as it
is not used anywhere and is not part of the public API.
---
 embed.fnc |  1 -
 embed.h   |  1 -
 proto.h   |  5 -----
 toke.c    | 12 ------------
 4 files changed, 19 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index e01d915b15..6337942f98 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1516,7 +1516,6 @@ p	|void	|write_to_stderr|NN SV* msv
 p	|int	|yyerror	|NN const char *const s
 p	|int	|yyerror_pv	|NN const char *const s|U32 flags
 p	|int	|yyerror_pvn	|NN const char *const s|STRLEN len|U32 flags
-p	|int	|yyerror_sv	|NN SV * sv|U32 flags
 : Used in perly.y, and by Data::Alias
 EXp	|int	|yylex
 p	|void	|yyunlex
diff --git a/embed.h b/embed.h
index 01505700ec..6f13c91479 100644
--- a/embed.h
+++ b/embed.h
@@ -1214,7 +1214,6 @@
 #define yyerror(a)		Perl_yyerror(aTHX_ a)
 #define yyerror_pv(a,b)		Perl_yyerror_pv(aTHX_ a,b)
 #define yyerror_pvn(a,b,c)	Perl_yyerror_pvn(aTHX_ a,b,c)
-#define yyerror_sv(a,b)		Perl_yyerror_sv(aTHX_ a,b)
 #define yyparse(a)		Perl_yyparse(aTHX_ a)
 #define yyunlex()		Perl_yyunlex(aTHX)
 #  if !(defined(DEBUGGING))
diff --git a/proto.h b/proto.h
index c9b51e9f69..88c3378b0c 100644
--- a/proto.h
+++ b/proto.h
@@ -4779,11 +4779,6 @@ PERL_CALLCONV int	Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 fl
 #define PERL_ARGS_ASSERT_YYERROR_PVN	\
 	assert(s)
 
-PERL_CALLCONV int	Perl_yyerror_sv(pTHX_ SV * sv, U32 flags)
-			__attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_YYERROR_SV	\
-	assert(sv)
-
 PERL_CALLCONV int	Perl_yylex(pTHX);
 PERL_CALLCONV int	Perl_yyparse(pTHX_ int gramtype);
 PERL_CALLCONV void	Perl_yyunlex(pTHX);
diff --git a/toke.c b/toke.c
index 08607efb25..346a39d64d 100644
--- a/toke.c
+++ b/toke.c
@@ -10739,18 +10739,6 @@ Perl_yyerror_pv(pTHX_ const char *const s, U32 flags)
     return yyerror_pvn(s, strlen(s), flags);
 }
 
-int
-Perl_yyerror_sv(pTHX_ SV * sv, U32 flags)
-{
-    char *s;
-    STRLEN len;
-    PERL_ARGS_ASSERT_YYERROR_SV;
-    s = SvPV(sv, len);
-    if (SvUTF8(sv))
-       flags |= SVf_UTF8;
-    return yyerror_pvn(s, len, flags);
-}
-
 int
 Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
 {
-- 
cgit v1.2.1


From 734ab32188dca45b1704abc89cd0f08809758da3 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sat, 6 Aug 2011 06:16:29 +0100
Subject: toke.c: S_no_op cleanup

---
 t/lib/subs/subs | 25 +++++++++++++++++++++++++
 toke.c          | 14 +++++++++-----
 2 files changed, 34 insertions(+), 5 deletions(-)

diff --git a/t/lib/subs/subs b/t/lib/subs/subs
index d4539dbf3a..e0bb16eadb 100644
--- a/t/lib/subs/subs
+++ b/t/lib/subs/subs
@@ -80,3 +80,28 @@ Fred 1, 2;
 sub Fred { print $_[0] + $_[1], "\n" }
 EXPECT
 3
+########
+
+# Error - not predeclaring a sub
+use utf8;
+use open qw( :utf8 :std );
+Frèd 1,2 ;
+sub Frèd {}
+EXPECT
+Number found where operator expected at - line 5, near "Frèd 1"
+	(Do you need to predeclare Frèd?)
+syntax error at - line 5, near "Frèd 1"
+Execution of - aborted due to compilation errors.
+########
+
+# Error - not predeclaring a sub in time
+use utf8;
+use open qw( :utf8 :std );
+ふれど 1,2 ;
+use subs qw( ふれど ) ;
+sub ふれど {}
+EXPECT
+Number found where operator expected at - line 5, near "ふれど 1"
+	(Do you need to predeclare ふれど?)
+syntax error at - line 5, near "ふれど 1"
+BEGIN not safe after errors--compilation aborted at - line 6.
diff --git a/toke.c b/toke.c
index 346a39d64d..3a3cddb760 100644
--- a/toke.c
+++ b/toke.c
@@ -537,24 +537,28 @@ S_no_op(pTHX_ const char *const what, char *s)
 	s = oldbp;
     else
 	PL_bufptr = s;
-    yywarn(Perl_form(aTHX_ "%s found where operator expected", what), 0);
+    yywarn(Perl_form(aTHX_ "%s found where operator expected", what), UTF ? SVf_UTF8 : 0);
     if (ckWARN_d(WARN_SYNTAX)) {
 	if (is_first)
 	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
 		    "\t(Missing semicolon on previous line?)\n");
 	else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) {
 	    const char *t;
-	    for (t = PL_oldoldbufptr; (isALNUM_lazy_if(t,UTF) || *t == ':'); t++)
+	    for (t = PL_oldoldbufptr; (isALNUM_lazy_if(t,UTF) || *t == ':');
+                                                            t += UTF ? UTF8SKIP(t) : 1)
 		NOOP;
 	    if (t < PL_bufptr && isSPACE(*t))
 		Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-			"\t(Do you need to predeclare %.*s?)\n",
-		    (int)(t - PL_oldoldbufptr), PL_oldoldbufptr);
+			"\t(Do you need to predeclare %"SVf"?)\n",
+		    SVfARG(newSVpvn_flags(PL_oldoldbufptr, (STRLEN)(t - PL_oldoldbufptr),
+                                   SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
 	}
 	else {
 	    assert(s >= oldbp);
 	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-		    "\t(Missing operator before %.*s?)\n", (int)(s - oldbp), oldbp);
+		    "\t(Missing operator before %"SVf"?)\n",
+                    SVfARG(newSVpvn_flags(oldbp, (STRLEN)(s - oldbp),
+                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
 	}
     }
     PL_bufptr = oldbp;
-- 
cgit v1.2.1


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


From 4c01a014641ade309fdf32a66b1e9939f10566ac Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sat, 6 Aug 2011 08:05:16 +0100
Subject: toke.c: 'You need to quote %s' cleanup.

---
 t/lib/warnings/toke | 20 ++++++++++++++++++++
 toke.c              |  8 +++++---
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 4c6c8fe6a2..2214005260 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -237,6 +237,26 @@ EXPECT
 You need to quote "fred" at - line 3.
 ########
 # toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+sub frèd {} ; $SIG{TERM} = frèd;
+no warnings 'syntax' ;
+$SIG{TERM} = frèd;
+EXPECT
+You need to quote "frèd" at - line 5.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+sub ふれど {} ; $SIG{TERM} = ふれど;
+no warnings 'syntax' ;
+$SIG{TERM} = ふれど;
+EXPECT
+You need to quote "ふれど" at - line 5.
+########
+# toke.c
 use warnings 'syntax' ;
 @a[3] = 2;
 @a{3} = 2;
diff --git a/toke.c b/toke.c
index c0a5cdaf09..426eb2ca23 100644
--- a/toke.c
+++ b/toke.c
@@ -6184,10 +6184,12 @@ Perl_yylex(pTHX)
 					      &len);
 				while (isSPACE(*t))
 				    t++;
-				if (*t == ';' && get_cvn_flags(tmpbuf, len, 0))
+				if (*t == ';'
+                                       && get_cvn_flags(tmpbuf, len, UTF ? SVf_UTF8 : 0))
 				    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-						"You need to quote \"%s\"",
-						tmpbuf);
+						"You need to quote \"%"SVf"\"",
+						  SVfARG(newSVpvn_flags(tmpbuf, len, 
+                                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
 			    }
 			}
 		}
-- 
cgit v1.2.1


From 08454bd8a4cf1faf0c407c322e5e8dff7c80478e Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 21 Mar 2012 22:34:13 -0700
Subject: uni/parser.t: Fix eval num in test

---
 t/uni/parser.t | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/t/uni/parser.t b/t/uni/parser.t
index 5b1c37be3d..f142edb609 100644
--- a/t/uni/parser.t
+++ b/t/uni/parser.t
@@ -105,6 +105,6 @@ 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.
+    is $@, 'Unrecognized character \x{1f42a}; marked by <-- HERE after  my $ニ <-- HERE near column 8 at (eval 11) line 1.
 ', "'Unrecognized character' croak is UTF-8 clean";
 }
-- 
cgit v1.2.1


From b9e186cd7765a6bc8b028fb122664ed6e4c17f70 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Thu, 22 Mar 2012 17:29:16 -0700
Subject: toke.c: 'Scalar value %s better written as $%s' cleanup.

---
 t/lib/warnings/toke | 26 ++++++++++++++++++++++++++
 toke.c              | 10 ++++++----
 2 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 2214005260..5a4af815d3 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -268,6 +268,32 @@ Scalar value @a[3] better written as $a[3] at - line 3.
 Scalar value @a{3} better written as $a{3} at - line 4.
 ########
 # toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+@à[3] = 2;
+@à{3} = 2;
+no warnings 'syntax' ;
+@à[3] = 2;
+@à{3} = 2;
+EXPECT
+Scalar value @à[3] better written as $à[3] at - line 5.
+Scalar value @à{3} better written as $à{3} at - line 6.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+@ぁ[3] = 2;
+@ぁ{3} = 2;
+no warnings 'syntax' ;
+@ぁ[3] = 2;
+@ぁ{3} = 2;
+EXPECT
+Scalar value @ぁ[3] better written as $ぁ[3] at - line 5.
+Scalar value @ぁ{3} better written as $ぁ{3} at - line 6.
+########
+# toke.c
 use warnings 'syntax' ;
 $_ = "ab" ; 
 s/(ab)/\1/e;
diff --git a/toke.c b/toke.c
index 426eb2ca23..9f6c32a897 100644
--- a/toke.c
+++ b/toke.c
@@ -6268,15 +6268,17 @@ Perl_yylex(pTHX)
 		if (ckWARN(WARN_SYNTAX)) {
 		    const char *t = s + 1;
 		    while (*t && (isALNUM_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
-			t++;
+			t += UTF ? UTF8SKIP(t) : 1;
 		    if (*t == '}' || *t == ']') {
 			t++;
 			PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
        /* diag_listed_as: Scalar value @%s[%s] better written as $%s[%s] */
 			Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-			    "Scalar value %.*s better written as $%.*s",
-			    (int)(t-PL_bufptr), PL_bufptr,
-			    (int)(t-PL_bufptr-1), PL_bufptr+1);
+			    "Scalar value %"SVf" better written as $%"SVf,
+			    SVfARG(newSVpvn_flags(PL_bufptr, (STRLEN)(t-PL_bufptr),
+                                                SVs_TEMP | (UTF ? SVf_UTF8 : 0 ))),
+                            SVfARG(newSVpvn_flags(PL_bufptr+1, (STRLEN)(t-PL_bufptr-1),
+                                                SVs_TEMP | (UTF ? SVf_UTF8 : 0 ))));
 		    }
 		}
 	    }
-- 
cgit v1.2.1


From 02571fe88c6515651a3a02e3a3903a559e55be7a Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sat, 6 Aug 2011 08:16:59 +0100
Subject: toke.c: 'Operator or semicolon missing before %c%s' cleanup.

---
 t/lib/warnings/toke | 20 ++++++++++++++++++++
 toke.c              |  6 ++++--
 2 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 5a4af815d3..4ce6ae4da3 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -736,6 +736,26 @@ Operator or semicolon missing before *foo at - line 10.
 Ambiguous use of * resolved as operator * at - line 10.
 ########
 # toke.c
+use utf8;
+use open qw( :utf8 :std );
+$^W = 0 ;
+*ｆｏｏ *ｆｏｏ ;
+{
+    no warnings 'ambiguous' ;
+    *ｆｏｏ *ｆｏｏ ;
+    use warnings 'ambiguous' ;
+    *ｆｏｏ *ｆｏｏ ;
+}
+*ｆｏｏ *ｆｏｏ ;
+EXPECT
+Operator or semicolon missing before *ｆｏｏ at - line 5.
+Ambiguous use of * resolved as operator * at - line 5.
+Operator or semicolon missing before *ｆｏｏ at - line 10.
+Ambiguous use of * resolved as operator * at - line 10.
+Operator or semicolon missing before *ｆｏｏ at - line 12.
+Ambiguous use of * resolved as operator * at - line 12.
+########
+# toke.c
 use warnings 'misc' ;
 my $a = "\m" ;
 no warnings 'misc' ;
diff --git a/toke.c b/toke.c
index 9f6c32a897..6a7e1efe45 100644
--- a/toke.c
+++ b/toke.c
@@ -7042,8 +7042,10 @@ Perl_yylex(pTHX)
 	    safe_bareword:
 		if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) {
 		    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
-				     "Operator or semicolon missing before %c%s",
-				     lastchar, PL_tokenbuf);
+				     "Operator or semicolon missing before %c%"SVf,
+				     lastchar, SVfARG(newSVpvn_flags(PL_tokenbuf,
+                                                    strlen(PL_tokenbuf),
+                                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
 		    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
 				     "Ambiguous use of %c resolved as operator %c",
 				     lastchar, lastchar);
-- 
cgit v1.2.1


From 3c54b17ac754f03829f63c4ed668e555e98f7623 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Thu, 22 Mar 2012 17:58:14 -0700
Subject: toke.c: 'No such class %s' cleanup.

---
 t/uni/parser.t | 11 ++++++++++-
 toke.c         |  2 +-
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/t/uni/parser.t b/t/uni/parser.t
index f142edb609..a3e3477d9d 100644
--- a/t/uni/parser.t
+++ b/t/uni/parser.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (tests => 38);
+plan (tests => 41);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -108,3 +108,12 @@ is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't";
     is $@, 'Unrecognized character \x{1f42a}; marked by <-- HERE after  my $ニ <-- HERE near column 8 at (eval 11) line 1.
 ', "'Unrecognized character' croak is UTF-8 clean";
 }
+
+{
+    use feature 'state';
+    for ( qw( my state our ) ) {
+        local $@;
+        eval "$_ Ｆｏｏ $x = 1;";
+        like $@, qr/No such class Ｆｏｏ/u, "'No such class' warning for $_ is UTF-8 clean";
+    }
+}
\ No newline at end of file
diff --git a/toke.c b/toke.c
index 6a7e1efe45..2fb0a56a0d 100644
--- a/toke.c
+++ b/toke.c
@@ -7675,7 +7675,7 @@ Perl_yylex(pTHX)
 		    char tmpbuf[1024];
 		    PL_bufptr = s;
 		    my_snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf);
-		    yyerror(tmpbuf);
+		    yyerror_pv(tmpbuf, UTF ? SVf_UTF8 : 0);
 		}
 #ifdef PERL_MAD
 		if (PL_madskills) {	/* just add type to declarator token */
-- 
cgit v1.2.1


From 4bca4ee0177ebddff4006e8fdc3f36628349ae11 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sat, 6 Aug 2011 10:35:22 +0100
Subject: toke.c: 'No package name allowed for variable %s in "our"' cleanup.

---
 t/uni/parser.t | 10 ++++++++--
 toke.c         |  4 ++--
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/t/uni/parser.t b/t/uni/parser.t
index a3e3477d9d..6530b66cc3 100644
--- a/t/uni/parser.t
+++ b/t/uni/parser.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (tests => 41);
+plan (tests => 42);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -116,4 +116,10 @@ is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't";
         eval "$_ Ｆｏｏ $x = 1;";
         like $@, qr/No such class Ｆｏｏ/u, "'No such class' warning for $_ is UTF-8 clean";
     }
-}
\ No newline at end of file
+}
+
+{
+    local $@;
+    eval "our \$main::\x{30cb};";
+    like $@, qr!No package name allowed for variable \$main::\x{30cb} in "our"!, "'No such package name allowed for variable' is UTF-8 clean";
+}
diff --git a/toke.c b/toke.c
index 2fb0a56a0d..aee009e425 100644
--- a/toke.c
+++ b/toke.c
@@ -8472,9 +8472,9 @@ S_pending_ident(pTHX)
     if (PL_in_my) {
         if (PL_in_my == KEY_our) {	/* "our" is merely analogous to "my" */
             if (has_colon)
-                yyerror(Perl_form(aTHX_ "No package name allowed for "
+                yyerror_pv(Perl_form(aTHX_ "No package name allowed for "
                                   "variable %s in \"our\"",
-                                  PL_tokenbuf));
+                                  PL_tokenbuf), UTF ? SVf_UTF8 : 0);
             tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
         }
         else {
-- 
cgit v1.2.1


From 58576270560ee142457377108b60beef6009e7cc Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sat, 6 Aug 2011 10:50:34 +0100
Subject: toke.c: '"(my|state)" variable %s can't be in a package' cleanup.

---
 t/uni/parser.t | 11 ++++++++++-
 toke.c         |  5 +++--
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/t/uni/parser.t b/t/uni/parser.t
index 6530b66cc3..e67871e944 100644
--- a/t/uni/parser.t
+++ b/t/uni/parser.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (tests => 42);
+plan (tests => 44);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -123,3 +123,12 @@ is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't";
     eval "our \$main::\x{30cb};";
     like $@, qr!No package name allowed for variable \$main::\x{30cb} in "our"!, "'No such package name allowed for variable' is UTF-8 clean";
 }
+
+{
+    use feature 'state';
+    local $@;
+    for ( qw( my state ) ) {
+        eval "$_ \$::\x{30cb};";
+        like $@, qr!"$_" variable \$::\x{30cb} can't be in a package!, qq!'"$_" variable %s can't be in a package' is UTF-8 clean!;
+    }
+}
diff --git a/toke.c b/toke.c
index aee009e425..9b74b3cc7c 100644
--- a/toke.c
+++ b/toke.c
@@ -8479,8 +8479,9 @@ S_pending_ident(pTHX)
         }
         else {
             if (has_colon)
-                yyerror(Perl_form(aTHX_ PL_no_myglob,
-			    PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
+                yyerror_pv(Perl_form(aTHX_ PL_no_myglob,
+			    PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf),
+                            UTF ? SVf_UTF8 : 0);
 
             pl_yylval.opval = newOP(OP_PADANY, 0);
             pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
-- 
cgit v1.2.1


From 29fb1d0ef33facc7d4fe58f19322d7d81ade25a8 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sat, 6 Aug 2011 11:03:16 +0100
Subject: toke.c: "Possible unintended interpolation of %s in string" cleanup.

---
 t/lib/warnings/toke | 22 +++++++++++++++++++++-
 toke.c              |  5 +++--
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 4ce6ae4da3..ef833bd347 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -844,11 +844,31 @@ no warning for overridden dump
 use warnings 'ambiguous';
 "@mjd_previously_unused_array";        
 no warnings 'ambiguous';
-"@mjd_previously_unused_array";        
+"@mjd_previously_unused_array2";        
 EXPECT
 Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3.
 ########
 # toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'ambiguous';
+"@mjd_previously_unused_àrray";        
+no warnings 'ambiguous';
+"@mjd_previously_unused_àrray2";        
+EXPECT
+Possible unintended interpolation of @mjd_previously_unused_àrray in string at - line 5.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'ambiguous';
+"@mjd_previously_unused_ぁrrぁy";        
+no warnings 'ambiguous';
+"@mjd_previously_unused_ぁrrぁy2";        
+EXPECT
+Possible unintended interpolation of @mjd_previously_unused_ぁrrぁy in string at - line 5.
+########
+# toke.c
 # 20020328 mjd-perl-patch+@plover.com at behest of jfriedl@yahoo.com
 use warnings 'regexp';
 "foo" =~ /foo/c;
diff --git a/toke.c b/toke.c
index 9b74b3cc7c..1696e24203 100644
--- a/toke.c
+++ b/toke.c
@@ -8568,8 +8568,9 @@ S_pending_ident(pTHX)
         {
             /* Downgraded from fatal to warning 20000522 mjd */
             Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-			"Possible unintended interpolation of %s in string",
-			PL_tokenbuf);
+			"Possible unintended interpolation of %"SVf" in string",
+			SVfARG(newSVpvn_flags(PL_tokenbuf, tokenbuf_len,
+                                        SVs_TEMP | ( UTF ? SVf_UTF8 : 0 ))));
         }
     }
 
-- 
cgit v1.2.1


From d0fb66e4dd07da2a32d4da479eecdd70515e9f20 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Sat, 6 Aug 2011 20:59:16 +0100
Subject: toke.c: S_checkcomma, "No comma allowed after %s" cleanup

---
 t/uni/parser.t | 8 +++++++-
 toke.c         | 5 +++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/t/uni/parser.t b/t/uni/parser.t
index e67871e944..256864cb80 100644
--- a/t/uni/parser.t
+++ b/t/uni/parser.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (tests => 44);
+plan (tests => 45);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -132,3 +132,9 @@ is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't";
         like $@, qr!"$_" variable \$::\x{30cb} can't be in a package!, qq!'"$_" variable %s can't be in a package' is UTF-8 clean!;
     }
 }
+
+{
+    local $@;
+    eval qq!print \x{30cb}, "comma""!;
+    like $@, qr/No comma allowed after filehandle/, "No comma allowed after filehandle triggers correctly for UTF-8 filehandles.";
+}
diff --git a/toke.c b/toke.c
index 1696e24203..0e6bc4de73 100644
--- a/toke.c
+++ b/toke.c
@@ -8623,9 +8623,10 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
     while (s < PL_bufend && isSPACE(*s))
 	s++;
     if (isIDFIRST_lazy_if(s,UTF)) {
-	const char * const w = s++;
+	const char * const w = s;
+        s += UTF ? UTF8SKIP(s) : 1;
 	while (isALNUM_lazy_if(s,UTF))
-	    s++;
+	    s += UTF ? UTF8SKIP(s) : 1;
 	while (s < PL_bufend && isSPACE(*s))
 	    s++;
 	if (*s == ',') {
-- 
cgit v1.2.1


From 5c66c3dde829c299f412b72bab2df6ea0f8afe02 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Thu, 22 Mar 2012 18:03:11 -0700
Subject: toke.c: "Ambiguous use of %c{%s} resolved to %c%s" cleanup.

---
 t/lib/warnings/toke | 22 ++++++++++++++++++++++
 toke.c              |  8 +++++---
 2 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index ef833bd347..a6841d2d09 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1096,3 +1096,25 @@ print "ok\n" if
     $@ =~ /Can't find string terminator "\xab" anywhere before EOF/;
 EXPECT
 ok
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'ambiguous' ;
+sub frèd {}
+$a = ${frèd} ;
+no warnings 'ambiguous' ;
+$a = ${frèd} ;
+EXPECT
+Ambiguous use of ${frèd} resolved to $frèd at - line 6.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'ambiguous' ;
+sub f렏 {}
+$a = ${f렏} ;
+no warnings 'ambiguous' ;
+$a = ${f렏} ;
+EXPECT
+Ambiguous use of ${f렏} resolved to $f렏 at - line 6.
diff --git a/toke.c b/toke.c
index 0e6bc4de73..e43bc744a8 100644
--- a/toke.c
+++ b/toke.c
@@ -8964,13 +8964,15 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
 	    if (PL_lex_state == LEX_NORMAL) {
 		if (ckWARN(WARN_AMBIGUOUS) &&
 		    (keyword(dest, d - dest, 0)
-		     || get_cvn_flags(dest, d - dest, 0)))
+		     || get_cvn_flags(dest, d - dest, UTF ? SVf_UTF8 : 0)))
 		{
+                    SV *tmp = newSVpvn_flags( dest, d - dest,
+                                            SVs_TEMP | (UTF ? SVf_UTF8 : 0) );
 		    if (funny == '#')
 			funny = '@';
 		    Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-			"Ambiguous use of %c{%s} resolved to %c%s",
-			funny, dest, funny, dest);
+			"Ambiguous use of %c{%"SVf"} resolved to %c%"SVf,
+			funny, tmp, funny, tmp);
 		}
 	    }
 	}
-- 
cgit v1.2.1