From: Father Chrysostomos Date: Sun, 23 Jun 2013 13:27:35 +0000 (-0700) Subject: Use UTF8f in more places X-Git-Tag: if-0.0603~57 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/acc19697c67fa63c10e07491b670a26c48f4175f Use UTF8f in more places This saves having to allocate as many SVs. --- diff --git a/gv.c b/gv.c index eeeb245..0d383ff 100644 --- a/gv.c +++ b/gv.c @@ -1026,10 +1026,9 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le return gv; } Perl_croak(aTHX_ - "Can't locate object method \"%"SVf + "Can't locate object method \"%"UTF8f "\" via package \"%"HEKf"\"", - SVfARG(newSVpvn_flags(name, nend - name, - SVs_TEMP | is_utf8)), + is_utf8, nend - name, name, HEKfARG(HvNAME_HEK(stash))); } else { @@ -1138,9 +1137,10 @@ 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"::%"SVf"() is deprecated", + "Use of inherited AUTOLOAD for non-method %"SVf + "::%"UTF8f"() is deprecated", SVfARG(packname), - SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8))); + is_utf8, len, name); 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; - I32 len; + STRLEN 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%"SVf"\" is not imported", + "Variable \"%c%"UTF8f"\" is not imported", sv_type == SVt_PVAV ? '@' : sv_type == SVt_PVHV ? '%' : '$', - SVfARG(namesv)); + is_utf8, len, name); if (GvCVu(*gvp)) Perl_ck_warner_d( aTHX_ packWARN(WARN_MISC), - "\t(Did you mean &%"SVf" instead?)\n", SVfARG(namesv) + "\t(Did you mean &%"UTF8f" instead?)\n", + is_utf8, len, name ); stash = NULL; } @@ -1597,15 +1597,14 @@ 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%"SVf"\" requires explicit package name", + "Global symbol \"%s%"UTF8f + "\" requires explicit package name", (sv_type == SVt_PV ? "$" : sv_type == SVt_PVAV ? "@" : sv_type == SVt_PVHV ? "%" - : ""), SVfARG(namesv)); + : ""), is_utf8, len, name); GV *gv; - SvREFCNT_dec_NN(namesv); if (is_utf8) SvUTF8_on(err); qerror(err); @@ -1700,8 +1699,9 @@ 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 %"SVf" unexpectedly", - SVfARG(newSVpvn_flags(nambeg, name_end-nambeg, SVs_TEMP | is_utf8 ))); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Had to create %"UTF8f" unexpectedly", + is_utf8, name_end-nambeg, nambeg); 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_ "%"SVf"::_GEN_%ld", - SVfARG(newSVpvn_flags(pack, strlen(pack), - SVs_TEMP | flags)), + return gv_fetchpv(Perl_form(aTHX_ "%"UTF8f"::_GEN_%ld", + flags, strlen(pack), pack, (long)PL_gensym++), GV_ADD, SVt_PVGV); } diff --git a/op.c b/op.c index fcc4760..ce51073 100644 --- a/op.c +++ b/op.c @@ -6843,14 +6843,12 @@ 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, " (%"SVf")", - SVfARG(newSVpvn_flags(cvp,clen, SvUTF8(cv)|SVs_TEMP)) - ); + Perl_sv_catpvf(aTHX_ msg, " (%"UTF8f")", SvUTF8(cv),clen,cvp); else sv_catpvs(msg, ": none"); sv_catpvs(msg, " vs "); if (p) - Perl_sv_catpvf(aTHX_ msg, "(%"SVf")", SVfARG(newSVpvn_flags(p, len, flags | SVs_TEMP))); + Perl_sv_catpvf(aTHX_ msg, "(%"UTF8f")", flags&SVf_UTF8,len,p); else sv_catpvs(msg, "none"); Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, SVfARG(msg)); diff --git a/pp.c b/pp.c index e3d3260..77a9f01 100644 --- a/pp.c +++ b/pp.c @@ -492,11 +492,8 @@ 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 \"%"SVf"\"", - SVfARG(newSVpvn_flags( - s+6, SvCUR(TOPs)-6, - (SvFLAGS(TOPs) & SVf_UTF8)|SVs_TEMP - ))); + DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"", + SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6); { SV * const sv = core_prototype(NULL, s + 6, code, NULL); if (sv) ret = sv; diff --git a/pp_ctl.c b/pp_ctl.c index f68336a..2f2dd79 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3070,9 +3070,8 @@ PP(pp_goto) PL_lastgotoprobe = gotoprobe; } if (!retop) - DIE(aTHX_ "Can't find label %"SVf, - SVfARG(newSVpvn_flags(label, label_len, - SVs_TEMP | label_flags))); + DIE(aTHX_ "Can't find label %"UTF8f, + label_flags, label_len, label); /* if we're leaving an eval, check before we pop any frames that we're not going to punt, otherwise the error diff --git a/toke.c b/toke.c index e31275d..3493c5b 100644 --- a/toke.c +++ b/toke.c @@ -553,16 +553,14 @@ 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 %"SVf"?)\n", - SVfARG(newSVpvn_flags(PL_oldoldbufptr, (STRLEN)(t - PL_oldoldbufptr), - SVs_TEMP | (UTF ? SVf_UTF8 : 0)))); + "\t(Do you need to predeclare %"UTF8f"?)\n", + UTF, (STRLEN)(t - PL_oldoldbufptr), PL_oldoldbufptr); } else { assert(s >= oldbp); Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "\t(Missing operator before %"SVf"?)\n", - SVfARG(newSVpvn_flags(oldbp, (STRLEN)(s - oldbp), - SVs_TEMP | (UTF ? SVf_UTF8 : 0)))); + "\t(Missing operator before %"UTF8f"?)\n", + UTF, (STRLEN)(s - oldbp), oldbp); } } PL_bufptr = oldbp; @@ -6501,9 +6499,8 @@ Perl_yylex(pTHX) if (*t == ';' && get_cvn_flags(tmpbuf, len, UTF ? SVf_UTF8 : 0)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "You need to quote \"%"SVf"\"", - SVfARG(newSVpvn_flags(tmpbuf, len, - SVs_TEMP | (UTF ? SVf_UTF8 : 0)))); + "You need to quote \"%"UTF8f"\"", + UTF, len, tmpbuf); } } } @@ -6588,11 +6585,9 @@ 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 %"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 )))); + "Scalar value %"UTF8f" better written as $%"UTF8f, + UTF, (STRLEN)(t-PL_bufptr), PL_bufptr, + UTF, (STRLEN)(t-PL_bufptr-1), PL_bufptr+1); } } } @@ -7035,9 +7030,8 @@ Perl_yylex(pTHX) s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len, TRUE, &morelen); if (!morelen) - Perl_croak(aTHX_ "Bad name after %"SVf"%s", - SVfARG(newSVpvn_flags(PL_tokenbuf, len, - (UTF ? SVf_UTF8 : 0) | SVs_TEMP )), + Perl_croak(aTHX_ "Bad name after %"UTF8f"%s", + UTF, len, PL_tokenbuf, *s == '\'' ? "'" : "::"); len += morelen; pkgname = 1; @@ -7064,9 +7058,8 @@ 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 \"%"SVf"\" refers to nonexistent package", - SVfARG(newSVpvn_flags(PL_tokenbuf, len, - (UTF ? SVf_UTF8 : 0) | SVs_TEMP))); + "Bareword \"%"UTF8f"\" refers to nonexistent package", + UTF, len, PL_tokenbuf); len -= 2; PL_tokenbuf[len] = '\0'; gv = NULL; @@ -7256,10 +7249,10 @@ Perl_yylex(pTHX) if (cv) { if (lastchar == '-' && penultchar != '-') { - const SV *tmpsv = newSVpvn_flags( PL_tokenbuf, len ? len : strlen(PL_tokenbuf), (UTF ? SVf_UTF8 : 0) | SVs_TEMP ); + const STRLEN l = len ? len : strlen(PL_tokenbuf); Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of -%"SVf" resolved as -&%"SVf"()", - SVfARG(tmpsv), SVfARG(tmpsv)); + "Ambiguous use of -%"UTF8f" resolved as -&%"UTF8f"()", + UTF, l, PL_tokenbuf, UTF, l, PL_tokenbuf); } /* Check for a constant sub */ if ((sv = cv_const_sv(cv))) { @@ -7434,10 +7427,9 @@ Perl_yylex(pTHX) safe_bareword: if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) { Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), - "Operator or semicolon missing before %c%"SVf, - lastchar, SVfARG(newSVpvn_flags(PL_tokenbuf, - strlen(PL_tokenbuf), - SVs_TEMP | (UTF ? SVf_UTF8 : 0)))); + "Operator or semicolon missing before %c%"UTF8f, + lastchar, UTF, strlen(PL_tokenbuf), + PL_tokenbuf); Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of %c resolved as operator %c", lastchar, lastchar); @@ -7597,9 +7589,8 @@ Perl_yylex(pTHX) goto just_a_word; } if (!tmp) - Perl_croak(aTHX_ "CORE::%"SVf" is not a keyword", - SVfARG(newSVpvn_flags(PL_tokenbuf, len, - (UTF ? SVf_UTF8 : 0) | SVs_TEMP))); + Perl_croak(aTHX_ "CORE::%"UTF8f" is not a keyword", + UTF, len, PL_tokenbuf); if (tmp < 0) tmp = -tmp; else if (tmp == KEY_require || tmp == KEY_do @@ -8158,8 +8149,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 %"SVf" should be open(%"SVf")", - SVfARG(tmpsv), SVfARG(tmpsv)); + "Precedence problem: open %"UTF8f" should be open(%"UTF8f")", + UTF, (STRLEN)(d-s), s, UTF, (STRLEN)(d-s), s); } } LOP(OP_OPEN,XTERM); @@ -9011,9 +9002,9 @@ S_pending_ident(pTHX) { /* Downgraded from fatal to warning 20000522 mjd */ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Possible unintended interpolation of %"SVf" in string", - SVfARG(newSVpvn_flags(PL_tokenbuf, tokenbuf_len, - SVs_TEMP | ( UTF ? SVf_UTF8 : 0 )))); + "Possible unintended interpolation of %"UTF8f + " in string", + UTF, tokenbuf_len, PL_tokenbuf); } } @@ -11404,9 +11395,8 @@ 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 \"%"SVf"\"\n", - SVfARG(newSVpvn_flags(context, contlen, - SVs_TEMP | (UTF ? SVf_UTF8 : 0)))); + Perl_sv_catpvf(aTHX_ msg, "near \"%"UTF8f"\"\n", + UTF, contlen, context); 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) {