toke.c: S_no_op cleanup

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;