summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Williamson <public@khwilliamson.com>2013-06-25 18:42:45 -0600
committerKarl Williamson <public@khwilliamson.com>2013-06-25 18:59:51 -0600
commitb3e714770ee1b3012dc2480cc4bc33146b13e6d5 (patch)
tree4fc763db40ab30338a2261f77ebf0c3cfd03ed47
parent1c8b67b38f0a53a8eee6b8fa0ed6fa49e4c25cc7 (diff)
downloadperl-b3e714770ee1b3012dc2480cc4bc33146b13e6d5.tar.gz
Revert "Use UTF8f in more places"
This reverts commit acc19697c67fa63c10e07491b670a26c48f4175f. This and the other UTF8f patch are causing significant problems on some configurations on 32-bit platforms. We've decided to revert them until they can be resubmitted after the kinks get ironed out.
-rw-r--r--gv.c38
-rw-r--r--op.c6
-rw-r--r--pp.c7
-rw-r--r--pp_ctl.c5
-rw-r--r--toke.c66
5 files changed, 69 insertions, 53 deletions
diff --git a/gv.c b/gv.c
index 87e94b0c7a..9658362e3e 100644
--- a/gv.c
+++ b/gv.c
@@ -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);
}
diff --git a/op.c b/op.c
index 857e59fa4f..aaebdaafe9 100644
--- a/op.c
+++ b/op.c
@@ -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));
diff --git a/pp.c b/pp.c
index f8a31e2cae..5efd87fceb 100644
--- a/pp.c
+++ b/pp.c
@@ -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;
diff --git a/pp_ctl.c b/pp_ctl.c
index 2f2dd795f0..f68336afe3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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
diff --git a/toke.c b/toke.c
index 0612011c92..aedccc555d 100644
--- a/toke.c
+++ b/toke.c
@@ -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) {