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
Update Changes
[perl5.git]
/
pp_hot.c
diff --git
a/pp_hot.c
b/pp_hot.c
index
6626b16
..
8298026
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;
}
@@
-153,7
+153,7
@@
PP(pp_concat)
if (TARG == right && right != left) {
right = sv_2mortal(newSVpvn(rpv, rlen));
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;
}
rcopied = TRUE;
}
@@
-186,7
+186,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);
@@
-971,7
+971,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);
@@
-1202,9
+1201,9
@@
PP(pp_match)
PUTBACK; /* EVAL blocks need stack_sp. */
s = SvPV_const(TARG, len);
PUTBACK; /* EVAL blocks need stack_sp. */
s = SvPV_const(TARG, len);
- strend = s + 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;
@@
-1301,7
+1300,6
@@
play_it_again:
EXTEND_MORTAL(nparens + i);
for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
EXTEND_MORTAL(nparens + i);
for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
- /*SUPPRESS 560*/
if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
const I32 len = rx->endp[i] - rx->startp[i];
s = rx->startp[i] + truebase;
if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
const I32 len = rx->endp[i] - rx->startp[i];
s = rx->startp[i] + truebase;
@@
-1475,7
+1473,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;
@@
-1496,8
+1494,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)",
@@
-1590,6
+1589,7
@@
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;
@@
-1598,21
+1598,21
@@
Perl_do_readline(pTHX)
SvCUR_set(sv, SvCUR(sv) - 1);
}
}
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_const(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",
@@
-1991,7
+1991,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) ||
@@
-2112,7
+2112,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;
@@
-2141,7
+2140,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);
@@
-2198,7
+2196,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);
}
@@
-2443,7
+2441,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);
@@
-2545,7
+2546,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) {
@@
-2681,7
+2682,8
@@
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;
@@
-2800,6
+2802,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. */
@@
-2843,7
+2846,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);
@@
-2942,10
+2945,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;
@@
-2959,7
+2962,7
@@
PP(pp_method)
PP(pp_method_named)
{
dSP;
PP(pp_method_named)
{
dSP;
- SV* sv = cSVOP_sv;
+ SV*
const
sv = cSVOP_sv;
U32 hash = SvSHARED_HASH(sv);
XPUSHs(method_common(sv, &hash));
U32 hash = SvSHARED_HASH(sv);
XPUSHs(method_common(sv, &hash));
@@
-2969,17
+2972,15
@@
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_const(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);
@@
-2992,8
+2993,6
@@
S_method_common(pTHX_ SV* meth, U32* hashp)
GV* iogv;
/* this isn't a reference */
GV* iogv;
/* this isn't a reference */
- packname = Nullch;
-
if(SvOK(sv) && (packname = SvPV_const(sv, packlen))) {
const HE* const he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
if (he) {
if(SvOK(sv) && (packname = SvPV_const(sv, packlen))) {
const HE* const he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
if (he) {
@@
-3085,7
+3084,7
@@
S_method_common(pTHX_ SV* meth, U32* hashp)
packname = CopSTASHPV(PL_curcop);
}
else if (stash) {
packname = CopSTASHPV(PL_curcop);
}
else if (stash) {
- HEK *packhek = HvNAME_HEK(stash);
+ HEK *
const
packhek = HvNAME_HEK(stash);
if (packhek) {
packname = HEK_KEY(packhek);
packlen = HEK_LEN(packhek);
if (packhek) {
packname = HEK_KEY(packhek);
packlen = HEK_LEN(packhek);