diff options
| -rw-r--r-- | gv.c | 38 | ||||
| -rw-r--r-- | op.c | 6 | ||||
| -rw-r--r-- | pp.c | 7 | ||||
| -rw-r--r-- | pp_ctl.c | 5 | ||||
| -rw-r--r-- | toke.c | 66 |
5 files changed, 69 insertions, 53 deletions
@@ -1026,9 +1026,10 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le return gv; } Perl_croak(aTHX_ - "Can't locate object method \"%"UTF8f + "Can't locate object method \"%"SVf "\" via package \"%"HEKf"\"", - is_utf8, nend - name, name, + SVfARG(newSVpvn_flags(name, nend - name, + SVs_TEMP | is_utf8)), HEKfARG(HvNAME_HEK(stash))); } else { @@ -1137,10 +1138,9 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) && (GvCVGEN(gv) || GvSTASH(gv) != stash) ) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "Use of inherited AUTOLOAD for non-method %"SVf - "::%"UTF8f"() is deprecated", + "Use of inherited AUTOLOAD for non-method %"SVf"::%"SVf"() is deprecated", SVfARG(packname), - is_utf8, len, name); + SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8))); if (CvISXSUB(cv)) { /* Instead of forcing the XSUB do another lookup for $AUTOLOAD @@ -1410,7 +1410,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, const char *name = nambeg; GV *gv = NULL; GV**gvp; - STRLEN len; + I32 len; const char *name_cursor; HV *stash = NULL; const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT); @@ -1569,18 +1569,18 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) || (sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) ) { + SV* namesv = newSVpvn_flags(name, len, SVs_TEMP | is_utf8); /* diag_listed_as: Variable "%s" is not imported%s */ Perl_ck_warner_d( aTHX_ packWARN(WARN_MISC), - "Variable \"%c%"UTF8f"\" is not imported", + "Variable \"%c%"SVf"\" is not imported", sv_type == SVt_PVAV ? '@' : sv_type == SVt_PVHV ? '%' : '$', - is_utf8, len, name); + SVfARG(namesv)); if (GvCVu(*gvp)) Perl_ck_warner_d( aTHX_ packWARN(WARN_MISC), - "\t(Did you mean &%"UTF8f" instead?)\n", - is_utf8, len, name + "\t(Did you mean &%"SVf" instead?)\n", SVfARG(namesv) ); stash = NULL; } @@ -1597,14 +1597,15 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (!stash) { if (add && !PL_in_clean_all) { + SV * const namesv = newSVpvn_flags(name, len, is_utf8); SV * const err = Perl_mess(aTHX_ - "Global symbol \"%s%"UTF8f - "\" requires explicit package name", + "Global symbol \"%s%"SVf"\" requires explicit package name", (sv_type == SVt_PV ? "$" : sv_type == SVt_PVAV ? "@" : sv_type == SVt_PVHV ? "%" - : ""), is_utf8, len, name); + : ""), SVfARG(namesv)); GV *gv; + SvREFCNT_dec_NN(namesv); if (is_utf8) SvUTF8_on(err); qerror(err); @@ -1699,9 +1700,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, faking_it = SvOK(gv); if (add & GV_ADDWARN) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Had to create %"UTF8f" unexpectedly", - is_utf8, name_end-nambeg, nambeg); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %"SVf" unexpectedly", + SVfARG(newSVpvn_flags(nambeg, name_end-nambeg, SVs_TEMP | is_utf8 ))); gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8); if ( isIDFIRST_lazy_if(name, is_utf8) @@ -2124,10 +2124,10 @@ Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags) { dVAR; PERL_ARGS_ASSERT_NEWGVGEN_FLAGS; - assert(!(flags & ~SVf_UTF8)); - return gv_fetchpv(Perl_form(aTHX_ "%"UTF8f"::_GEN_%ld", - flags, strlen(pack), pack, + return gv_fetchpv(Perl_form(aTHX_ "%"SVf"::_GEN_%ld", + SVfARG(newSVpvn_flags(pack, strlen(pack), + SVs_TEMP | flags)), (long)PL_gensym++), GV_ADD, SVt_PVGV); } @@ -6844,12 +6844,14 @@ Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p, if (name) Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name)); if (cvp) - Perl_sv_catpvf(aTHX_ msg, " (%"UTF8f")", SvUTF8(cv),clen,cvp); + Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", + SVfARG(newSVpvn_flags(cvp,clen, SvUTF8(cv)|SVs_TEMP)) + ); else sv_catpvs(msg, ": none"); sv_catpvs(msg, " vs "); if (p) - Perl_sv_catpvf(aTHX_ msg, "(%"UTF8f")", flags&SVf_UTF8,len,p); + Perl_sv_catpvf(aTHX_ msg, "(%"SVf")", SVfARG(newSVpvn_flags(p, len, flags | SVs_TEMP))); else sv_catpvs(msg, "none"); Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, SVfARG(msg)); @@ -492,8 +492,11 @@ PP(pp_prototype) if (strnEQ(s, "CORE::", 6)) { const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1); if (!code || code == -KEY_CORE) - DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"", - SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6); + DIE(aTHX_ "Can't find an opnumber for \"%"SVf"\"", + SVfARG(newSVpvn_flags( + s+6, SvCUR(TOPs)-6, + (SvFLAGS(TOPs) & SVf_UTF8)|SVs_TEMP + ))); { SV * const sv = core_prototype(NULL, s + 6, code, NULL); if (sv) ret = sv; @@ -3070,8 +3070,9 @@ PP(pp_goto) PL_lastgotoprobe = gotoprobe; } if (!retop) - DIE(aTHX_ "Can't find label %"UTF8f, - label_flags, label_len, label); + DIE(aTHX_ "Can't find label %"SVf, + SVfARG(newSVpvn_flags(label, label_len, + SVs_TEMP | label_flags))); /* if we're leaving an eval, check before we pop any frames that we're not going to punt, otherwise the error @@ -553,14 +553,16 @@ S_no_op(pTHX_ const char *const what, char *s) NOOP; if (t < PL_bufptr && isSPACE(*t)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "\t(Do you need to predeclare %"UTF8f"?)\n", - UTF, (STRLEN)(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 %"UTF8f"?)\n", - UTF, (STRLEN)(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; @@ -6499,8 +6501,9 @@ Perl_yylex(pTHX) if (*t == ';' && get_cvn_flags(tmpbuf, len, UTF ? SVf_UTF8 : 0)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "You need to quote \"%"UTF8f"\"", - UTF, len, tmpbuf); + "You need to quote \"%"SVf"\"", + SVfARG(newSVpvn_flags(tmpbuf, len, + SVs_TEMP | (UTF ? SVf_UTF8 : 0)))); } } } @@ -6585,9 +6588,11 @@ Perl_yylex(pTHX) 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 %"UTF8f" better written as $%"UTF8f, - UTF, (STRLEN)(t-PL_bufptr), PL_bufptr, - UTF, (STRLEN)(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 )))); } } } @@ -7030,8 +7035,9 @@ Perl_yylex(pTHX) s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len, TRUE, &morelen); if (!morelen) - Perl_croak(aTHX_ "Bad name after %"UTF8f"%s", - UTF, len, PL_tokenbuf, + Perl_croak(aTHX_ "Bad name after %"SVf"%s", + SVfARG(newSVpvn_flags(PL_tokenbuf, len, + (UTF ? SVf_UTF8 : 0) | SVs_TEMP )), *s == '\'' ? "'" : "::"); len += morelen; pkgname = 1; @@ -7058,8 +7064,9 @@ Perl_yylex(pTHX) if (ckWARN(WARN_BAREWORD) && ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV)) Perl_warner(aTHX_ packWARN(WARN_BAREWORD), - "Bareword \"%"UTF8f"\" refers to nonexistent package", - UTF, len, PL_tokenbuf); + "Bareword \"%"SVf"\" refers to nonexistent package", + SVfARG(newSVpvn_flags(PL_tokenbuf, len, + (UTF ? SVf_UTF8 : 0) | SVs_TEMP))); len -= 2; PL_tokenbuf[len] = '\0'; gv = NULL; @@ -7249,10 +7256,10 @@ Perl_yylex(pTHX) if (cv) { if (lastchar == '-' && penultchar != '-') { - const STRLEN l = len ? len : strlen(PL_tokenbuf); + const SV *tmpsv = newSVpvn_flags( PL_tokenbuf, len ? len : strlen(PL_tokenbuf), (UTF ? SVf_UTF8 : 0) | SVs_TEMP ); Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of -%"UTF8f" resolved as -&%"UTF8f"()", - UTF, l, PL_tokenbuf, UTF, l, PL_tokenbuf); + "Ambiguous use of -%"SVf" resolved as -&%"SVf"()", + SVfARG(tmpsv), SVfARG(tmpsv)); } /* Check for a constant sub */ if ((sv = cv_const_sv(cv))) { @@ -7428,9 +7435,10 @@ Perl_yylex(pTHX) safe_bareword: if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) { Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), - "Operator or semicolon missing before %c%"UTF8f, - lastchar, UTF, strlen(PL_tokenbuf), - 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); @@ -7590,8 +7598,9 @@ Perl_yylex(pTHX) goto just_a_word; } if (!tmp) - Perl_croak(aTHX_ "CORE::%"UTF8f" is not a keyword", - UTF, len, PL_tokenbuf); + Perl_croak(aTHX_ "CORE::%"SVf" is not a keyword", + SVfARG(newSVpvn_flags(PL_tokenbuf, len, + (UTF ? SVf_UTF8 : 0) | SVs_TEMP))); if (tmp < 0) tmp = -tmp; else if (tmp == KEY_require || tmp == KEY_do @@ -8150,8 +8159,8 @@ Perl_yylex(pTHX) SV *tmpsv = newSVpvn_flags(s, (STRLEN)(d-s), SVs_TEMP | (UTF ? SVf_UTF8 : 0)); Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE), - "Precedence problem: open %"UTF8f" should be open(%"UTF8f")", - UTF, (STRLEN)(d-s), s, UTF, (STRLEN)(d-s), s); + "Precedence problem: open %"SVf" should be open(%"SVf")", + SVfARG(tmpsv), SVfARG(tmpsv)); } } LOP(OP_OPEN,XTERM); @@ -9003,9 +9012,9 @@ S_pending_ident(pTHX) { /* Downgraded from fatal to warning 20000522 mjd */ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Possible unintended interpolation of %"UTF8f - " in string", - UTF, tokenbuf_len, PL_tokenbuf); + "Possible unintended interpolation of %"SVf" in string", + SVfARG(newSVpvn_flags(PL_tokenbuf, tokenbuf_len, + SVs_TEMP | ( UTF ? SVf_UTF8 : 0 )))); } } @@ -11396,8 +11405,9 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags) Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ", OutCopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); if (context) - Perl_sv_catpvf(aTHX_ msg, "near \"%"UTF8f"\"\n", - UTF, 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, "%"SVf"\n", SVfARG(where_sv)); if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) { |