diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-03-22 20:34:32 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-03-22 20:34:32 -0700 |
commit | 15d94df60eb08a44107e2aaf4c9e5e8b26e084b6 (patch) | |
tree | 8addcfba1535b8211933ca51ccacd3f48d433aec | |
parent | 7dbb22ac4fc2faadcfeea71c1929eea024e4f502 (diff) | |
parent | 5c66c3dde829c299f412b72bab2df6ea0f8afe02 (diff) | |
download | perl-15d94df60eb08a44107e2aaf4c9e5e8b26e084b6.tar.gz |
[Merge] Some more UTF8 patches
This branch represents more of Brian Fraser’s patches from
<https://github.com/Hugmeir/gsoc-pad-utf8-safety/commits/tokemess>,
that are referenced by perl #107008.
This is not all of it, but all I’ve merged and tested so far.
-rw-r--r-- | embed.fnc | 4 | ||||
-rw-r--r-- | embed.h | 4 | ||||
-rw-r--r-- | proto.h | 12 | ||||
-rw-r--r-- | t/lib/subs/subs | 25 | ||||
-rw-r--r-- | t/lib/warnings/toke | 110 | ||||
-rw-r--r-- | t/uni/parser.t | 40 | ||||
-rw-r--r-- | toke.c | 123 |
7 files changed, 271 insertions, 47 deletions
@@ -1514,6 +1514,8 @@ 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 : Used in perly.y, and by Data::Alias EXp |int |yylex p |void |yyunlex @@ -1522,7 +1524,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 @@ -1212,6 +1212,8 @@ #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 yyparse(a) Perl_yyparse(aTHX_ a) #define yyunlex() Perl_yyunlex(aTHX) # if !(defined(DEBUGGING)) @@ -1594,7 +1596,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) @@ -4769,6 +4769,16 @@ 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_yylex(pTHX); PERL_CALLCONV int Perl_yyparse(pTHX_ int gramtype); PERL_CALLCONV void Perl_yyunlex(pTHX); @@ -7104,7 +7114,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/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/t/lib/warnings/toke b/t/lib/warnings/toke index 4c6c8fe6a2..a6841d2d09 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; @@ -248,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; @@ -690,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 ; +*foo *foo ; +{ + no warnings 'ambiguous' ; + *foo *foo ; + use warnings 'ambiguous' ; + *foo *foo ; +} +*foo *foo ; +EXPECT +Operator or semicolon missing before *foo at - line 5. +Ambiguous use of * resolved as operator * at - line 5. +Operator or semicolon missing before *foo at - line 10. +Ambiguous use of * resolved as operator * at - line 10. +Operator or semicolon missing before *foo at - line 12. +Ambiguous use of * resolved as operator * at - line 12. +######## +# toke.c use warnings 'misc' ; my $a = "\m" ; no warnings 'misc' ; @@ -778,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; @@ -1010,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/t/uni/parser.t b/t/uni/parser.t index 42c95203c3..256864cb80 100644 --- a/t/uni/parser.t +++ b/t/uni/parser.t @@ -7,7 +7,7 @@ BEGIN { require './test.pl'; } -plan (tests => 37); +plan (tests => 45); use utf8; use open qw( :utf8 :std ); @@ -100,3 +100,41 @@ 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 11) line 1. +', "'Unrecognized character' croak is UTF-8 clean"; +} + +{ + use feature 'state'; + for ( qw( my state our ) ) { + local $@; + eval "$_ Foo $x = 1;"; + like $@, qr/No such class Foo/u, "'No such class' warning for $_ is UTF-8 clean"; + } +} + +{ + 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"; +} + +{ + 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!; + } +} + +{ + 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."; +} @@ -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)); + 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; @@ -4761,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; @@ -4769,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: @@ -6172,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)))); } } } @@ -6254,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 )))); } } } @@ -7026,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); @@ -7657,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 */ @@ -8454,15 +8472,16 @@ 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 { 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, @@ -8549,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 )))); } } @@ -8603,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 == ',') { @@ -8943,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); } } } @@ -10713,14 +10736,14 @@ 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; } @@ -10728,17 +10751,32 @@ S_yywarn(pTHX_ const char *const s) 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_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 +10811,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 +10831,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", |