This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Upgrade to ExtUtils-CBuilder-0.15 (with a small edit to
[perl5.git]
/
pp_hot.c
diff --git
a/pp_hot.c
b/pp_hot.c
index
1d1a792
..
72f657d
100644
(file)
--- a/
pp_hot.c
+++ b/
pp_hot.c
@@
-58,7
+58,7
@@
PP(pp_gvsv)
if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(save_scalar(cGVOP_gv));
else
if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(save_scalar(cGVOP_gv));
else
- PUSHs(GvSV(cGVOP_gv));
+ PUSHs(GvSV
n
(cGVOP_gv));
RETURN;
}
RETURN;
}
@@
-147,19
+147,19
@@
PP(pp_concat)
dPOPTOPssrl;
bool lbyte;
STRLEN rlen;
dPOPTOPssrl;
bool lbyte;
STRLEN rlen;
- const char *rpv = SvPV
(right, rlen);
/* mg_get(right) happens here */
+ const char *rpv = SvPV
_const(right, rlen);
/* mg_get(right) happens here */
const bool rbyte = !DO_UTF8(right);
bool rcopied = FALSE;
if (TARG == right && right != left) {
right = sv_2mortal(newSVpvn(rpv, rlen));
const bool rbyte = !DO_UTF8(right);
bool rcopied = FALSE;
if (TARG == right && right != left) {
right = sv_2mortal(newSVpvn(rpv, rlen));
- rpv = SvPV
(right, rlen);
/* no point setting UTF-8 here */
+ rpv = SvPV
_const(right, rlen);
/* no point setting UTF-8 here */
rcopied = TRUE;
}
if (TARG != left) {
STRLEN llen;
rcopied = TRUE;
}
if (TARG != left) {
STRLEN llen;
- const char* const lpv = SvPV
(left, llen);
/* mg_get(left) may happen here */
+ const char* const lpv = SvPV
_const(left, llen);
/* mg_get(left) may happen here */
lbyte = !DO_UTF8(left);
sv_setpvn(TARG, lpv, llen);
if (!lbyte)
lbyte = !DO_UTF8(left);
sv_setpvn(TARG, lpv, llen);
if (!lbyte)
@@
-169,11
+169,10
@@
PP(pp_concat)
}
else { /* TARG == left */
STRLEN llen;
}
else { /* TARG == left */
STRLEN llen;
- if (SvGMAGICAL(left))
- mg_get(left); /* or mg_get(left) may happen here */
+ SvGETMAGIC(left); /* or mg_get(left) may happen here */
if (!SvOK(TARG))
sv_setpvn(left, "", 0);
if (!SvOK(TARG))
sv_setpvn(left, "", 0);
- (void)SvPV_nomg(left, llen); /* Needed to set UTF8 flag */
+ (void)SvPV_nomg
_const
(left, llen); /* Needed to set UTF8 flag */
lbyte = !DO_UTF8(left);
if (IN_BYTES)
SvUTF8_off(TARG);
lbyte = !DO_UTF8(left);
if (IN_BYTES)
SvUTF8_off(TARG);
@@
-186,7
+185,7
@@
PP(pp_concat)
if (!rcopied)
right = sv_2mortal(newSVpvn(rpv, rlen));
sv_utf8_upgrade_nomg(right);
if (!rcopied)
right = sv_2mortal(newSVpvn(rpv, rlen));
sv_utf8_upgrade_nomg(right);
- rpv = SvPV(right, rlen);
+ rpv = SvPV
_const
(right, rlen);
}
}
sv_catpvn_nomg(TARG, rpv, rlen);
}
}
sv_catpvn_nomg(TARG, rpv, rlen);
@@
-329,9
+328,8
@@
PP(pp_dor)
{
/* Most of this is lifted straight from pp_defined */
dSP;
{
/* Most of this is lifted straight from pp_defined */
dSP;
- register SV*
sv
;
+ register SV*
const sv = TOPs
;
- sv = TOPs;
if (!sv || !SvANY(sv)) {
--SP;
RETURNOP(cLOGOP->op_other);
if (!sv || !SvANY(sv)) {
--SP;
RETURNOP(cLOGOP->op_other);
@@
-351,8
+349,7
@@
PP(pp_dor)
RETURN;
break;
default:
RETURN;
break;
default:
- if (SvGMAGICAL(sv))
- mg_get(sv);
+ SvGETMAGIC(sv);
if (SvOK(sv))
RETURN;
}
if (SvOK(sv))
RETURN;
}
@@
-434,7
+431,7
@@
PP(pp_add)
if ((auvok = SvUOK(TOPm1s)))
auv = SvUVX(TOPm1s);
else {
if ((auvok = SvUOK(TOPm1s)))
auv = SvUVX(TOPm1s);
else {
- register IV aiv = SvIVX(TOPm1s);
+ register
const
IV aiv = SvIVX(TOPm1s);
if (aiv >= 0) {
auv = aiv;
auvok = 1; /* Now acting as a sign flag. */
if (aiv >= 0) {
auv = aiv;
auvok = 1; /* Now acting as a sign flag. */
@@
-454,7
+451,7
@@
PP(pp_add)
if (buvok)
buv = SvUVX(TOPs);
else {
if (buvok)
buv = SvUVX(TOPs);
else {
- register IV biv = SvIVX(TOPs);
+ register
const
IV biv = SvIVX(TOPs);
if (biv >= 0) {
buv = biv;
buvok = 1;
if (biv >= 0) {
buv = biv;
buvok = 1;
@@
-528,7
+525,7
@@
PP(pp_aelemfast)
dSP;
AV *av = PL_op->op_flags & OPf_SPECIAL ?
(AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
dSP;
AV *av = PL_op->op_flags & OPf_SPECIAL ?
(AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
- U32 lval = PL_op->op_flags & OPf_MOD;
+
const
U32 lval = PL_op->op_flags & OPf_MOD;
SV** svp = av_fetch(av, PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
EXTEND(SP, 1);
SV** svp = av_fetch(av, PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
EXTEND(SP, 1);
@@
-770,7
+767,7
@@
PP(pp_rv2av)
}
if (GIMME == G_ARRAY) {
}
if (GIMME == G_ARRAY) {
- I32 maxarg = AvFILL(av) + 1;
+
const
I32 maxarg = AvFILL(av) + 1;
(void)POPs; /* XXXX May be optimized away? */
EXTEND(SP, maxarg);
if (SvRMAGICAL(av)) {
(void)POPs; /* XXXX May be optimized away? */
EXTEND(SP, maxarg);
if (SvRMAGICAL(av)) {
@@
-790,7
+787,7
@@
PP(pp_rv2av)
}
else if (GIMME_V == G_SCALAR) {
dTARGET;
}
else if (GIMME_V == G_SCALAR) {
dTARGET;
- I32 maxarg = AvFILL(av) + 1;
+
const
I32 maxarg = AvFILL(av) + 1;
SETi(maxarg);
}
RETURN;
SETi(maxarg);
}
RETURN;
@@
-800,7
+797,8
@@
PP(pp_rv2hv)
{
dSP; dTOPss;
HV *hv;
{
dSP; dTOPss;
HV *hv;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
+ static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
if (SvROK(sv)) {
wasref:
if (SvROK(sv)) {
wasref:
@@
-815,7
+813,7
@@
PP(pp_rv2hv)
}
else if (LVRET) {
if (gimme != G_ARRAY)
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_
"Can't return hash to lvalue scalar context"
);
+ Perl_croak(aTHX_
return_hash_to_lvalue_scalar
);
SETs((SV*)hv);
RETURN;
}
SETs((SV*)hv);
RETURN;
}
@@
-832,8
+830,7
@@
PP(pp_rv2hv)
}
else if (LVRET) {
if (gimme != G_ARRAY)
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_ "Can't return hash to lvalue"
- " scalar context");
+ Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
SETs((SV*)hv);
RETURN;
}
SETs((SV*)hv);
RETURN;
}
@@
-888,8
+885,7
@@
PP(pp_rv2hv)
}
else if (LVRET) {
if (gimme != G_ARRAY)
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_ "Can't return hash to lvalue"
- " scalar context");
+ Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
SETs((SV*)hv);
RETURN;
}
SETs((SV*)hv);
RETURN;
}
@@
-913,20
+909,20
@@
S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
{
if (*relem) {
SV *tmpstr;
{
if (*relem) {
SV *tmpstr;
- HE *didstore;
+
const
HE *didstore;
if (ckWARN(WARN_MISC)) {
if (ckWARN(WARN_MISC)) {
+ const char *err;
if (relem == firstrelem &&
SvROK(*relem) &&
(SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV))
{
if (relem == firstrelem &&
SvROK(*relem) &&
(SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV))
{
- Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Reference found where even-sized list expected");
+ err = "Reference found where even-sized list expected";
}
else
}
else
- Perl_warner(aTHX_ packWARN(WARN_MISC),
-
"Odd number of elements in hash assignment"
);
+ err = "Odd number of elements in hash assignment";
+
Perl_warner(aTHX_ packWARN(WARN_MISC), err
);
}
tmpstr = NEWSV(29,0);
}
tmpstr = NEWSV(29,0);
@@
-973,7
+969,6
@@
PP(pp_aassign)
if (PL_op->op_private & (OPpASSIGN_COMMON)) {
EXTEND_MORTAL(lastrelem - firstrelem + 1);
for (relem = firstrelem; relem <= lastrelem; relem++) {
if (PL_op->op_private & (OPpASSIGN_COMMON)) {
EXTEND_MORTAL(lastrelem - firstrelem + 1);
for (relem = firstrelem; relem <= lastrelem; relem++) {
- /*SUPPRESS 560*/
if ((sv = *relem)) {
TAINT_NOT; /* Each item is independent */
*relem = sv_mortalcopy(sv);
if ((sv = *relem)) {
TAINT_NOT; /* Each item is independent */
*relem = sv_mortalcopy(sv);
@@
-1178,18
+1173,18
@@
PP(pp_match)
dSP; dTARG;
register PMOP *pm = cPMOP;
PMOP *dynpm = pm;
dSP; dTARG;
register PMOP *pm = cPMOP;
PMOP *dynpm = pm;
- register char *t;
- register char *s;
- char *strend;
+
const
register char *t;
+
const
register char *s;
+ c
onst c
har *strend;
I32 global;
I32 r_flags = REXEC_CHECKED;
I32 global;
I32 r_flags = REXEC_CHECKED;
- c
har *truebase;
/* Start of string */
+ c
onst char *truebase;
/* Start of string */
register REGEXP *rx = PM_GETRE(pm);
bool rxtainted;
register REGEXP *rx = PM_GETRE(pm);
bool rxtainted;
- I32 gimme = GIMME;
+
const
I32 gimme = GIMME;
STRLEN len;
I32 minmatch = 0;
STRLEN len;
I32 minmatch = 0;
- I32 oldsave = PL_savestack_ix;
+
const
I32 oldsave = PL_savestack_ix;
I32 update_minmatch = 1;
I32 had_zerolen = 0;
I32 update_minmatch = 1;
I32 had_zerolen = 0;
@@
-1203,10
+1198,10
@@
PP(pp_match)
}
PUTBACK; /* EVAL blocks need stack_sp. */
}
PUTBACK; /* EVAL blocks need stack_sp. */
- s = SvPV(TARG, len);
- strend = s + len;
+ s = SvPV_const(TARG, len);
if (!s)
DIE(aTHX_ "panic: pp_match");
if (!s)
DIE(aTHX_ "panic: pp_match");
+ strend = s + len;
rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
(PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
TAINT_NOT;
rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
(PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
TAINT_NOT;
@@
-1265,8
+1260,9
@@
play_it_again:
}
if (rx->reganch & RE_USE_INTUIT &&
DO_UTF8(TARG) == ((rx->reganch & ROPT_UTF8) != 0)) {
}
if (rx->reganch & RE_USE_INTUIT &&
DO_UTF8(TARG) == ((rx->reganch & ROPT_UTF8) != 0)) {
- PL_bostr = truebase;
- s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL);
+ /* FIXME - can PL_bostr be made const char *? */
+ PL_bostr = (char *)truebase;
+ s = CALLREG_INTUIT_START(aTHX_ rx, TARG, (char *)s, (char *)strend, r_flags, NULL);
if (!s)
goto nope;
if (!s)
goto nope;
@@
-1278,7
+1274,7
@@
play_it_again:
&& !SvROK(TARG)) /* Cannot trust since INTUIT cannot guess ^ */
goto yup;
}
&& !SvROK(TARG)) /* Cannot trust since INTUIT cannot guess ^ */
goto yup;
}
- if (CALLREGEXEC(aTHX_ rx,
s, strend,
truebase, minmatch, TARG, NULL, r_flags))
+ if (CALLREGEXEC(aTHX_ rx,
(char*)s, (char *)strend, (char*)
truebase, minmatch, TARG, NULL, r_flags))
{
PL_curpm = pm;
if (dynpm->op_pmflags & PMf_ONCE)
{
PL_curpm = pm;
if (dynpm->op_pmflags & PMf_ONCE)
@@
-1294,21
+1290,16
@@
play_it_again:
RX_MATCH_TAINTED_on(rx);
TAINT_IF(RX_MATCH_TAINTED(rx));
if (gimme == G_ARRAY) {
RX_MATCH_TAINTED_on(rx);
TAINT_IF(RX_MATCH_TAINTED(rx));
if (gimme == G_ARRAY) {
- I32 nparens, i, len;
+ const I32 nparens = rx->nparens;
+ I32 i = (global && !nparens) ? 1 : 0;
- nparens = rx->nparens;
- if (global && !nparens)
- i = 1;
- else
- i = 0;
SPAGAIN; /* EVAL blocks could move the stack. */
EXTEND(SP, nparens + i);
EXTEND_MORTAL(nparens + i);
for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
SPAGAIN; /* EVAL blocks could move the stack. */
EXTEND(SP, nparens + i);
EXTEND_MORTAL(nparens + i);
for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
- /*SUPPRESS 560*/
if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
- len = rx->endp[i] - rx->startp[i];
+
const I32
len = rx->endp[i] - rx->startp[i];
s = rx->startp[i] + truebase;
if (rx->endp[i] < 0 || rx->startp[i] < 0 ||
len < 0 || len > strend - s)
s = rx->startp[i] + truebase;
if (rx->endp[i] < 0 || rx->startp[i] < 0 ||
len < 0 || len > strend - s)
@@
-1379,7
+1370,8
@@
yup: /* Confirmed by INTUIT */
RX_MATCH_COPIED_off(rx);
rx->subbeg = Nullch;
if (global) {
RX_MATCH_COPIED_off(rx);
rx->subbeg = Nullch;
if (global) {
- rx->subbeg = truebase;
+ /* FIXME - should rx->subbeg be const char *? */
+ rx->subbeg = (char *) truebase;
rx->startp[0] = s - truebase;
if (RX_MATCH_UTF8(rx)) {
char *t = (char*)utf8_hop((U8*)s, rx->minlen);
rx->startp[0] = s - truebase;
if (RX_MATCH_UTF8(rx)) {
char *t = (char*)utf8_hop((U8*)s, rx->minlen);
@@
-1393,7
+1385,7
@@
yup: /* Confirmed by INTUIT */
}
if (PL_sawampersand) {
I32 off;
}
if (PL_sawampersand) {
I32 off;
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log,
if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log,
@@
-1402,14
+1394,14
@@
yup: /* Confirmed by INTUIT */
(int)(t-truebase));
}
rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
(int)(t-truebase));
}
rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
- rx->subbeg =
SvPVX
(rx->saved_copy) + (t - truebase);
+ rx->subbeg =
(char *) SvPVX_const
(rx->saved_copy) + (t - truebase);
assert (SvPOKp(rx->saved_copy));
} else
#endif
{
rx->subbeg = savepvn(t, strend - t);
assert (SvPOKp(rx->saved_copy));
} else
#endif
{
rx->subbeg = savepvn(t, strend - t);
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
rx->saved_copy = Nullsv;
#endif
}
rx->saved_copy = Nullsv;
#endif
}
@@
-1449,9
+1441,9
@@
Perl_do_readline(pTHX)
STRLEN tmplen = 0;
STRLEN offset;
PerlIO *fp;
STRLEN tmplen = 0;
STRLEN offset;
PerlIO *fp;
- register IO *io = GvIO(PL_last_in_gv);
- register I32 type = PL_op->op_type;
- I32 gimme = GIMME_V;
+ register IO *
const
io = GvIO(PL_last_in_gv);
+ register
const
I32 type = PL_op->op_type;
+
const
I32 gimme = GIMME_V;
MAGIC *mg;
if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
MAGIC *mg;
if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
@@
-1479,7
+1471,7
@@
Perl_do_readline(pTHX)
if (av_len(GvAVn(PL_last_in_gv)) < 0) {
IoFLAGS(io) &= ~IOf_START;
do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
if (av_len(GvAVn(PL_last_in_gv)) < 0) {
IoFLAGS(io) &= ~IOf_START;
do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
- sv_setpvn(GvSV(PL_last_in_gv), "-", 1);
+ sv_setpvn(GvSV
n
(PL_last_in_gv), "-", 1);
SvSETMAGIC(GvSV(PL_last_in_gv));
fp = IoIFP(io);
goto have_fp;
SvSETMAGIC(GvSV(PL_last_in_gv));
fp = IoIFP(io);
goto have_fp;
@@
-1500,8
+1492,9
@@
Perl_do_readline(pTHX)
}
}
if (!fp) {
}
}
if (!fp) {
- if (ckWARN2(WARN_GLOB, WARN_CLOSED)
- && (!io || !(IoFLAGS(io) & IOf_START))) {
+ if ((!io || !(IoFLAGS(io) & IOf_START))
+ && ckWARN2(WARN_GLOB, WARN_CLOSED))
+ {
if (type == OP_GLOB)
Perl_warner(aTHX_ packWARN(WARN_GLOB),
"glob failed (can't start child: %s)",
if (type == OP_GLOB)
Perl_warner(aTHX_ packWARN(WARN_GLOB),
"glob failed (can't start child: %s)",
@@
-1524,15
+1517,14
@@
Perl_do_readline(pTHX)
sv = TARG;
if (SvROK(sv))
sv_unref(sv);
sv = TARG;
if (SvROK(sv))
sv_unref(sv);
-
(void)
SvUPGRADE(sv, SVt_PV);
+ SvUPGRADE(sv, SVt_PV);
tmplen = SvLEN(sv); /* remember if already alloced */
if (!tmplen && !SvREADONLY(sv))
Sv_Grow(sv, 80); /* try short-buffering it */
offset = 0;
if (type == OP_RCATLINE && SvOK(sv)) {
if (!SvPOK(sv)) {
tmplen = SvLEN(sv); /* remember if already alloced */
if (!tmplen && !SvREADONLY(sv))
Sv_Grow(sv, 80); /* try short-buffering it */
offset = 0;
if (type == OP_RCATLINE && SvOK(sv)) {
if (!SvPOK(sv)) {
- STRLEN n_a;
- (void)SvPV_force(sv, n_a);
+ SvPV_force_nolen(sv);
}
offset = SvCUR(sv);
}
}
offset = SvCUR(sv);
}
@@
-1595,29
+1587,30
@@
Perl_do_readline(pTHX)
XPUSHs(sv);
if (type == OP_GLOB) {
char *tmps;
XPUSHs(sv);
if (type == OP_GLOB) {
char *tmps;
+ const char *t1;
if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
tmps = SvEND(sv) - 1;
if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
tmps = SvEND(sv) - 1;
- if (*tmps == *SvPVX(PL_rs)) {
+ if (*tmps == *SvPVX
_const
(PL_rs)) {
*tmps = '\0';
SvCUR_set(sv, SvCUR(sv) - 1);
}
}
*tmps = '\0';
SvCUR_set(sv, SvCUR(sv) - 1);
}
}
- for (t
mps = SvPVX(sv); *tmps; tmps
++)
- if (!isALPHA(*t
mps) && !isDIGIT(*tmps
) &&
- strchr("$&*(){}[]'\";\\|?<>~`", *t
mps
))
+ for (t
1 = SvPVX_const(sv); *t1; t1
++)
+ if (!isALPHA(*t
1) && !isDIGIT(*t1
) &&
+ strchr("$&*(){}[]'\";\\|?<>~`", *t
1
))
break;
break;
- if (*t
mps && PerlLIO_lstat(SvPVX
(sv), &PL_statbuf) < 0) {
+ if (*t
1 && PerlLIO_lstat(SvPVX_const
(sv), &PL_statbuf) < 0) {
(void)POPs; /* Unmatched wildcard? Chuck it... */
continue;
}
} else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
(void)POPs; /* Unmatched wildcard? Chuck it... */
continue;
}
} else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
- const U8 *s = (
U8*)SvPVX
(sv) + offset;
+ const U8 *s = (
const U8*)SvPVX_const
(sv) + offset;
const STRLEN len = SvCUR(sv) - offset;
const U8 *f;
if (ckWARN(WARN_UTF8) &&
const STRLEN len = SvCUR(sv) - offset;
const U8 *f;
if (ckWARN(WARN_UTF8) &&
- !Perl_is_utf8_string_loc(aTHX_ s, len, &f))
+
!Perl_is_utf8_string_loc(aTHX_ s, len, &f))
/* Emulate :encoding(utf8) warning in the same case. */
Perl_warner(aTHX_ packWARN(WARN_UTF8),
"utf8 \"\\x%02X\" does not map to Unicode",
/* Emulate :encoding(utf8) warning in the same case. */
Perl_warner(aTHX_ packWARN(WARN_UTF8),
"utf8 \"\\x%02X\" does not map to Unicode",
@@
-1668,14
+1661,10
@@
PP(pp_helem)
SV **svp;
SV *keysv = POPs;
HV *hv = (HV*)POPs;
SV **svp;
SV *keysv = POPs;
HV *hv = (HV*)POPs;
- U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
- U32 defer = PL_op->op_private & OPpLVAL_DEFER;
+
const
U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
+
const
U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
SV *sv;
-#ifdef PERL_COPY_ON_WRITE
- U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0;
-#else
- U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
-#endif
+ const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0;
I32 preeminent = 0;
if (SvTYPE(hv) == SVt_PVHV) {
I32 preeminent = 0;
if (SvTYPE(hv) == SVt_PVHV) {
@@
-1722,12
+1711,12
@@
PP(pp_helem)
RETURN;
}
if (PL_op->op_private & OPpLVAL_INTRO) {
RETURN;
}
if (PL_op->op_private & OPpLVAL_INTRO) {
- if (HvNAME(hv) && isGV(*svp))
+ if (HvNAME
_get
(hv) && isGV(*svp))
save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
else {
if (!preeminent) {
STRLEN keylen;
save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
else {
if (!preeminent) {
STRLEN keylen;
- c
har *key = SvPV
(keysv, keylen);
+ c
onst char * const key = SvPV_const
(keysv, keylen);
SAVEDELETE(hv, savepvn(key,keylen), keylen);
} else
save_helem(hv, keysv, svp);
SAVEDELETE(hv, savepvn(key,keylen), keylen);
} else
save_helem(hv, keysv, svp);
@@
-1753,7
+1742,6
@@
PP(pp_leave)
{
dVAR; dSP;
register PERL_CONTEXT *cx;
{
dVAR; dSP;
register PERL_CONTEXT *cx;
- register SV **mark;
SV **newsp;
PMOP *newpm;
I32 gimme;
SV **newsp;
PMOP *newpm;
I32 gimme;
@@
-1777,6
+1765,7
@@
PP(pp_leave)
if (gimme == G_VOID)
SP = newsp;
else if (gimme == G_SCALAR) {
if (gimme == G_VOID)
SP = newsp;
else if (gimme == G_SCALAR) {
+ register SV **mark;
MARK = newsp + 1;
if (MARK <= SP) {
if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
MARK = newsp + 1;
if (MARK <= SP) {
if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
@@
-1791,6
+1780,7
@@
PP(pp_leave)
}
else if (gimme == G_ARRAY) {
/* in case LEAVE wipes old return values */
}
else if (gimme == G_ARRAY) {
/* in case LEAVE wipes old return values */
+ register SV **mark;
for (mark = newsp + 1; mark <= SP; mark++) {
if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
*mark = sv_mortalcopy(*mark);
for (mark = newsp + 1; mark <= SP; mark++) {
if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
*mark = sv_mortalcopy(*mark);
@@
-1826,7
+1816,7
@@
PP(pp_iter)
/* string increment */
register SV* cur = cx->blk_loop.iterlval;
STRLEN maxlen = 0;
/* string increment */
register SV* cur = cx->blk_loop.iterlval;
STRLEN maxlen = 0;
- const char *max = SvOK((SV*)av) ? SvPV((SV*)av, maxlen) : "";
+ const char *max = SvOK((SV*)av) ? SvPV
_const
((SV*)av, maxlen) : "";
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
@@
-1841,7
+1831,7
@@
PP(pp_iter)
*itersvp = newSVsv(cur);
SvREFCNT_dec(oldsv);
}
*itersvp = newSVsv(cur);
SvREFCNT_dec(oldsv);
}
- if (strEQ(SvPVX(cur), max))
+ if (strEQ(SvPVX
_const
(cur), max))
sv_setiv(cur, 0); /* terminate next time */
else
sv_inc(cur);
sv_setiv(cur, 0); /* terminate next time */
else
sv_inc(cur);
@@
-1949,7
+1939,7
@@
PP(pp_subst)
register char *s;
char *strend;
register char *m;
register char *s;
char *strend;
register char *m;
- char *c;
+ c
onst c
har *c;
register char *d;
STRLEN clen;
I32 iters = 0;
register char *d;
STRLEN clen;
I32 iters = 0;
@@
-1965,7
+1955,7
@@
PP(pp_subst)
I32 oldsave = PL_savestack_ix;
STRLEN slen;
bool doutf8 = FALSE;
I32 oldsave = PL_savestack_ix;
STRLEN slen;
bool doutf8 = FALSE;
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
bool is_cow;
#endif
SV *nsv = Nullsv;
bool is_cow;
#endif
SV *nsv = Nullsv;
@@
-1981,7
+1971,7
@@
PP(pp_subst)
EXTEND(SP,1);
}
EXTEND(SP,1);
}
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
/* Awooga. Awooga. "bool" types that are actually char are dangerous,
because they make integers such as 256 "false". */
is_cow = SvIsCOW(TARG) ? TRUE : FALSE;
/* Awooga. Awooga. "bool" types that are actually char are dangerous,
because they make integers such as 256 "false". */
is_cow = SvIsCOW(TARG) ? TRUE : FALSE;
@@
-1990,7
+1980,7
@@
PP(pp_subst)
sv_force_normal_flags(TARG,0);
#endif
if (
sv_force_normal_flags(TARG,0);
#endif
if (
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
!is_cow &&
#endif
(SvREADONLY(TARG)
!is_cow &&
#endif
(SvREADONLY(TARG)
@@
-1999,7
+1989,7
@@
PP(pp_subst)
DIE(aTHX_ PL_no_modify);
PUTBACK;
DIE(aTHX_ PL_no_modify);
PUTBACK;
- s = SvPV(TARG, len);
+ s = SvPV
_mutable
(TARG, len);
if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
force_on_match = 1;
rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
force_on_match = 1;
rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
@@
-2059,11
+2049,11
@@
PP(pp_subst)
sv_recode_to_utf8(nsv, PL_encoding);
else
sv_utf8_upgrade(nsv);
sv_recode_to_utf8(nsv, PL_encoding);
else
sv_utf8_upgrade(nsv);
- c = SvPV(nsv, clen);
+ c = SvPV
_const
(nsv, clen);
doutf8 = TRUE;
}
else {
doutf8 = TRUE;
}
else {
- c = SvPV(dstr, clen);
+ c = SvPV
_const
(dstr, clen);
doutf8 = DO_UTF8(dstr);
}
}
doutf8 = DO_UTF8(dstr);
}
}
@@
-2074,7
+2064,7
@@
PP(pp_subst)
/* can do inplace substitution? */
if (c
/* can do inplace substitution? */
if (c
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
&& !is_cow
#endif
&& (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
&& !is_cow
#endif
&& (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
@@
-2088,7
+2078,7
@@
PP(pp_subst)
LEAVE_SCOPE(oldsave);
RETURN;
}
LEAVE_SCOPE(oldsave);
RETURN;
}
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
if (SvIsCOW(TARG)) {
assert (!force_on_match);
goto have_a_cow;
if (SvIsCOW(TARG)) {
assert (!force_on_match);
goto have_a_cow;
@@
-2120,7
+2110,6
@@
PP(pp_subst)
*m = '\0';
SvCUR_set(TARG, m - s);
}
*m = '\0';
SvCUR_set(TARG, m - s);
}
- /*SUPPRESS 560*/
else if ((i = m - s)) { /* faster from front */
d -= clen;
m = d;
else if ((i = m - s)) { /* faster from front */
d -= clen;
m = d;
@@
-2149,7
+2138,6
@@
PP(pp_subst)
DIE(aTHX_ "Substitution loop");
rxtainted |= RX_MATCH_TAINTED(rx);
m = rx->startp[0] + orig;
DIE(aTHX_ "Substitution loop");
rxtainted |= RX_MATCH_TAINTED(rx);
m = rx->startp[0] + orig;
- /*SUPPRESS 560*/
if ((i = m - s)) {
if (s != d)
Move(s, d, i, char);
if ((i = m - s)) {
if (s != d)
Move(s, d, i, char);
@@
-2166,7
+2154,7
@@
PP(pp_subst)
REXEC_NOT_FIRST|REXEC_IGNOREPOS));
if (s != d) {
i = strend - s;
REXEC_NOT_FIRST|REXEC_IGNOREPOS));
if (s != d) {
i = strend - s;
- SvCUR_set(TARG, d - SvPVX(TARG) + i);
+ SvCUR_set(TARG, d - SvPVX
_const
(TARG) + i);
Move(s, d, i+1, char); /* include the NUL */
}
TAINT_IF(rxtainted & 1);
Move(s, d, i+1, char); /* include the NUL */
}
TAINT_IF(rxtainted & 1);
@@
-2195,7
+2183,7
@@
PP(pp_subst)
s = SvPV_force(TARG, len);
goto force_it;
}
s = SvPV_force(TARG, len);
goto force_it;
}
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
have_a_cow:
#endif
rxtainted |= RX_MATCH_TAINTED(rx);
have_a_cow:
#endif
rxtainted |= RX_MATCH_TAINTED(rx);
@@
-2206,7
+2194,7
@@
PP(pp_subst)
if (!c) {
register PERL_CONTEXT *cx;
SPAGAIN;
if (!c) {
register PERL_CONTEXT *cx;
SPAGAIN;
- ReREFCNT_inc(rx);
+
(void)
ReREFCNT_inc(rx);
PUSHSUBST(cx);
RETURNOP(cPMOP->op_pmreplroot);
}
PUSHSUBST(cx);
RETURNOP(cPMOP->op_pmreplroot);
}
@@
-2239,7
+2227,7
@@
PP(pp_subst)
else
sv_catpvn(dstr, s, strend - s);
else
sv_catpvn(dstr, s, strend - s);
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_
OLD_
COPY_ON_WRITE
/* The match may make the string COW. If so, brilliant, because that's
just saved us one malloc, copy and free - the regexp has donated
the old buffer, and we malloc an entirely new one, rather than the
/* The match may make the string COW. If so, brilliant, because that's
just saved us one malloc, copy and free - the regexp has donated
the old buffer, and we malloc an entirely new one, rather than the
@@
-2451,7
+2439,10
@@
PP(pp_leavesublv)
MARK = newsp + 1;
EXTEND_MORTAL(1);
if (MARK == SP) {
MARK = newsp + 1;
EXTEND_MORTAL(1);
if (MARK == SP) {
- if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
+ /* Temporaries are bad unless they happen to be elements
+ * of a tied hash or array */
+ if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
+ !(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
LEAVE;
cxstack_ix--;
POPSUB(cx,sv);
LEAVE;
cxstack_ix--;
POPSUB(cx,sv);
@@
-2553,7
+2544,7
@@
PP(pp_leavesublv)
STATIC CV *
S_get_db_sub(pTHX_ SV **svp, CV *cv)
{
STATIC CV *
S_get_db_sub(pTHX_ SV **svp, CV *cv)
{
- SV *dbsv = GvSV(PL_DBsub);
+ SV *dbsv = GvSV
n
(PL_DBsub);
save_item(dbsv);
if (!PERLDB_SUB_NN) {
save_item(dbsv);
if (!PERLDB_SUB_NN) {
@@
-2623,11
+2614,10
@@
PP(pp_entersub)
mg_get(sv);
if (SvROK(sv))
goto got_rv;
mg_get(sv);
if (SvROK(sv))
goto got_rv;
- sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
+ sym = SvPOKp(sv) ? SvPVX
_const
(sv) : Nullch;
}
else {
}
else {
- STRLEN n_a;
- sym = SvPV(sv, n_a);
+ sym = SvPV_nolen_const(sv);
}
if (!sym)
DIE(aTHX_ PL_no_usym, "a subroutine");
}
if (!sym)
DIE(aTHX_ PL_no_usym, "a subroutine");
@@
-2690,12
+2680,11
@@
PP(pp_entersub)
PERL_STACK_OVERFLOW_CHECK();
pad_push(padlist, CvDEPTH(cv));
}
PERL_STACK_OVERFLOW_CHECK();
pad_push(padlist, CvDEPTH(cv));
}
- PAD_SET_CUR(padlist, CvDEPTH(cv));
+ SAVECOMPPAD();
+ PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
if (hasargs)
{
AV* av;
if (hasargs)
{
AV* av;
- SV** ary;
-
#if 0
DEBUG_S(PerlIO_printf(Perl_debug_log,
"%p entersub preparing @_\n", thr));
#if 0
DEBUG_S(PerlIO_printf(Perl_debug_log,
"%p entersub preparing @_\n", thr));
@@
-2715,7
+2704,7
@@
PP(pp_entersub)
++MARK;
if (items > AvMAX(av) + 1) {
++MARK;
if (items > AvMAX(av) + 1) {
- ary = AvALLOC(av);
+
SV **
ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
SvPV_set(av, (char*)ary);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
SvPV_set(av, (char*)ary);
@@
-2778,10
+2767,8
@@
PP(pp_entersub)
/* Need to copy @_ to stack. Alternative may be to
* switch stack to @_, and copy return values
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
/* Need to copy @_ to stack. Alternative may be to
* switch stack to @_, and copy return values
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
- AV* av;
- I32 items;
- av = GvAV(PL_defgv);
- items = AvFILLp(av) + 1; /* @_ is not tieable */
+ AV * const av = GvAV(PL_defgv);
+ const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */
if (items) {
/* Mark is at the end of the stack. */
if (items) {
/* Mark is at the end of the stack. */
@@
-2813,6
+2800,7
@@
PP(pp_entersub)
return NORMAL;
}
return NORMAL;
}
+ /*NOTREACHED*/
assert (0); /* Cannot get here. */
/* This is deliberately moved here as spaghetti code to keep it out of the
hot path. */
assert (0); /* Cannot get here. */
/* This is deliberately moved here as spaghetti code to keep it out of the
hot path. */
@@
-2856,7
+2844,7
@@
Perl_sub_crush_depth(pTHX_ CV *cv)
if (CvANON(cv))
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
else {
if (CvANON(cv))
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
else {
- SV* tmpstr = sv_newmortal();
+ SV*
const
tmpstr = sv_newmortal();
gv_efullname3(tmpstr, CvGV(cv), Nullch);
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
tmpstr);
gv_efullname3(tmpstr, CvGV(cv), Nullch);
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
tmpstr);
@@
-2867,7
+2855,7
@@
PP(pp_aelem)
{
dSP;
SV** svp;
{
dSP;
SV** svp;
- SV* elemsv = POPs;
+ SV*
const
elemsv = POPs;
IV elem = SvIV(elemsv);
AV* av = (AV*)POPs;
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
IV elem = SvIV(elemsv);
AV* av = (AV*)POPs;
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
@@
-2883,16
+2871,17
@@
PP(pp_aelem)
svp = av_fetch(av, elem, lval && !defer);
if (lval) {
#ifdef PERL_MALLOC_WRAP
svp = av_fetch(av, elem, lval && !defer);
if (lval) {
#ifdef PERL_MALLOC_WRAP
- static const char oom_array_extend[] =
- "Out of memory during array extend"; /* Duplicated in av.c */
if (SvUOK(elemsv)) {
const UV uv = SvUV(elemsv);
elem = uv > IV_MAX ? IV_MAX : uv;
}
else if (SvNOK(elemsv))
elem = (IV)SvNV(elemsv);
if (SvUOK(elemsv)) {
const UV uv = SvUV(elemsv);
elem = uv > IV_MAX ? IV_MAX : uv;
}
else if (SvNOK(elemsv))
elem = (IV)SvNV(elemsv);
- if (elem > 0)
+ if (elem > 0) {
+ static const char oom_array_extend[] =
+ "Out of memory during array extend"; /* Duplicated in av.c */
MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend);
MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend);
+ }
#endif
if (!svp || *svp == &PL_sv_undef) {
SV* lv;
#endif
if (!svp || *svp == &PL_sv_undef) {
SV* lv;
@@
-2923,8
+2912,7
@@
PP(pp_aelem)
void
Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
{
void
Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
{
- if (SvGMAGICAL(sv))
- mg_get(sv);
+ SvGETMAGIC(sv);
if (!SvOK(sv)) {
if (SvREADONLY(sv))
Perl_croak(aTHX_ PL_no_modify);
if (!SvOK(sv)) {
if (SvREADONLY(sv))
Perl_croak(aTHX_ PL_no_modify);
@@
-2954,10
+2942,10
@@
Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
PP(pp_method)
{
dSP;
PP(pp_method)
{
dSP;
- SV* sv = TOPs;
+ SV*
const
sv = TOPs;
if (SvROK(sv)) {
if (SvROK(sv)) {
- SV* rsv = SvRV(sv);
+ SV*
const
rsv = SvRV(sv);
if (SvTYPE(rsv) == SVt_PVCV) {
SETs(rsv);
RETURN;
if (SvTYPE(rsv) == SVt_PVCV) {
SETs(rsv);
RETURN;
@@
-2971,8
+2959,8
@@
PP(pp_method)
PP(pp_method_named)
{
dSP;
PP(pp_method_named)
{
dSP;
- SV* sv = cSVOP_sv;
- U32 hash = Sv
UVX
(sv);
+ SV*
const
sv = cSVOP_sv;
+ U32 hash = Sv
SHARED_HASH
(sv);
XPUSHs(method_common(sv, &hash));
RETURN;
XPUSHs(method_common(sv, &hash));
RETURN;
@@
-2981,34
+2969,28
@@
PP(pp_method_named)
STATIC SV *
S_method_common(pTHX_ SV* meth, U32* hashp)
{
STATIC SV *
S_method_common(pTHX_ SV* meth, U32* hashp)
{
- SV* sv;
SV* ob;
GV* gv;
HV* stash;
STRLEN namelen;
SV* ob;
GV* gv;
HV* stash;
STRLEN namelen;
- const char* packname =
0
;
+ const char* packname =
Nullch
;
SV *packsv = Nullsv;
STRLEN packlen;
SV *packsv = Nullsv;
STRLEN packlen;
- const char *name = SvPV(meth, namelen);
-
- sv = *(PL_stack_base + TOPMARK + 1);
+ const char * const name = SvPV_const(meth, namelen);
+ SV * const sv = *(PL_stack_base + TOPMARK + 1);
if (!sv)
Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
if (!sv)
Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
- if (SvGMAGICAL(sv))
- mg_get(sv);
+ SvGETMAGIC(sv);
if (SvROK(sv))
ob = (SV*)SvRV(sv);
else {
GV* iogv;
/* this isn't a reference */
if (SvROK(sv))
ob = (SV*)SvRV(sv);
else {
GV* iogv;
/* this isn't a reference */
- packname = Nullch;
-
- if(SvOK(sv) && (packname = SvPV(sv, packlen))) {
- HE* he;
- he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
+ if(SvOK(sv) && (packname = SvPV_const(sv, packlen))) {
+ const HE* const he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
if (he) {
stash = INT2PTR(HV*,SvIV(HeVAL(he)));
goto fetch;
if (he) {
stash = INT2PTR(HV*,SvIV(HeVAL(he)));
goto fetch;
@@
-3062,7
+3044,7
@@
S_method_common(pTHX_ SV* meth, U32* hashp)
/* shortcut for simple names */
if (hashp) {
/* shortcut for simple names */
if (hashp) {
-
HE*
he = hv_fetch_ent(stash, meth, 0, *hashp);
+
const HE* const
he = hv_fetch_ent(stash, meth, 0, *hashp);
if (he) {
gv = (GV*)HeVAL(he);
if (isGV(gv) && GvCV(gv) &&
if (he) {
gv = (GV*)HeVAL(he);
if (isGV(gv) && GvCV(gv) &&
@@
-3092,14
+3074,30
@@
S_method_common(pTHX_ SV* meth, U32* hashp)
sep = p, leaf = p + 2;
}
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
sep = p, leaf = p + 2;
}
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
- /* the method name is unqualified or starts with SUPER:: */
- packname = sep ? CopSTASHPV(PL_curcop) :
- stash ? HvNAME(stash) : packname;
- if (!packname)
+ /* the method name is unqualified or starts with SUPER:: */
+ bool need_strlen = 1;
+ if (sep) {
+ packname = CopSTASHPV(PL_curcop);
+ }
+ else if (stash) {
+ HEK * const packhek = HvNAME_HEK(stash);
+ if (packhek) {
+ packname = HEK_KEY(packhek);
+ packlen = HEK_LEN(packhek);
+ need_strlen = 0;
+ } else {
+ goto croak;
+ }
+ }
+
+ if (!packname) {
+ croak:
Perl_croak(aTHX_
"Can't use anonymous symbol table for method lookup");
Perl_croak(aTHX_
"Can't use anonymous symbol table for method lookup");
- else
+ }
+ else if (need_strlen)
packlen = strlen(packname);
packlen = strlen(packname);
+
}
else {
/* the method name is qualified */
}
else {
/* the method name is qualified */