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

index d4539db..e0bb16e 100644 (file)
@@ -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 346a39d..3a3cddb 100644 (file)
--- 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;