if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(save_scalar(cGVOP_gv));
else
- PUSHs(GvSV(cGVOP_gv));
+ PUSHs(GvSVn(cGVOP_gv));
RETURN;
}
if (!SvTRUE(TOPs))
RETURN;
else {
- --SP;
+ if (PL_op->op_type == OP_AND)
+ --SP;
RETURNOP(cLOGOP->op_other);
}
}
}
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);
(void)SvPV_nomg_const(left, llen); /* Needed to set UTF8 flag */
if (SvTRUE(TOPs))
RETURN;
else {
- --SP;
+ if (PL_op->op_type == OP_OR)
+ --SP;
RETURNOP(cLOGOP->op_other);
}
}
-PP(pp_dor)
+PP(pp_defined)
{
- /* Most of this is lifted straight from pp_defined */
dSP;
- register SV* const sv = TOPs;
+ register SV* sv = NULL;
+ bool defined = FALSE;
+ const int op_type = PL_op->op_type;
+
+ if(op_type == OP_DOR || op_type == OP_DORASSIGN) {
+ sv = TOPs;
+ if (!sv || !SvANY(sv)) {
+ if (op_type == OP_DOR)
+ --SP;
+ RETURNOP(cLOGOP->op_other);
+ }
+ } else if (op_type == OP_DEFINED) {
+ sv = POPs;
+ if (!sv || !SvANY(sv))
+ RETPUSHNO;
+ } else
+ DIE(aTHX_ "panic: Invalid op passed to dd_defined()");
- if (!sv || !SvANY(sv)) {
- --SP;
- RETURNOP(cLOGOP->op_other);
- }
-
switch (SvTYPE(sv)) {
case SVt_PVAV:
if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
- RETURN;
+ defined = TRUE;
break;
case SVt_PVHV:
if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
- RETURN;
+ defined = TRUE;
break;
case SVt_PVCV:
if (CvROOT(sv) || CvXSUB(sv))
- RETURN;
+ defined = TRUE;
break;
default:
- if (SvGMAGICAL(sv))
- mg_get(sv);
+ SvGETMAGIC(sv);
if (SvOK(sv))
- RETURN;
+ defined = TRUE;
}
- --SP;
- RETURNOP(cLOGOP->op_other);
+ if(op_type == OP_DOR || op_type == OP_DORASSIGN) {
+ if(defined)
+ RETURN;
+ if(op_type == OP_DOR)
+ --SP;
+ RETURNOP(cLOGOP->op_other);
+ }
+ /* assuming OP_DEFINED */
+ if(defined)
+ RETPUSHYES;
+ RETPUSHNO;
}
PP(pp_add)
* We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
* will be enough to hold an OP*.
*/
- SV* sv = sv_newmortal();
+ SV* const sv = sv_newmortal();
sv_upgrade(sv, SVt_PVLV);
LvTYPE(sv) = '/';
Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
}
}
SP = ORIGMARK;
- PUSHs(&PL_sv_yes);
+ XPUSHs(&PL_sv_yes);
RETURN;
just_say_no:
SP = ORIGMARK;
- PUSHs(&PL_sv_undef);
+ XPUSHs(&PL_sv_undef);
RETURN;
}
PP(pp_qr)
{
dSP;
- register PMOP *pm = cPMOP;
- SV *rv = sv_newmortal();
- SV *sv = newSVrv(rv, "Regexp");
+ register PMOP * const pm = cPMOP;
+ SV * const rv = sv_newmortal();
+ SV * const sv = newSVrv(rv, "Regexp");
if (pm->op_pmdynflags & PMdf_TAINTED)
SvTAINTED_on(rv);
sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
dSP; dTARG;
register PMOP *pm = cPMOP;
PMOP *dynpm = pm;
- const register char *t;
- const register char *s;
+ register const char *t;
+ register const char *s;
const char *strend;
I32 global;
I32 r_flags = REXEC_CHECKED;
PUTBACK; /* EVAL blocks need stack_sp. */
s = SvPV_const(TARG, len);
- strend = s + len;
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;
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(GvSVn(PL_last_in_gv), "-", 1);
SvSETMAGIC(GvSV(PL_last_in_gv));
fp = IoIFP(io);
goto have_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)",
const U8 *f;
if (ckWARN(WARN_UTF8) &&
- !Perl_is_utf8_string_loc(aTHX_ s, len, &f))
+ !is_utf8_string_loc(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",
/* All done yet? */
if (PL_stack_base + *PL_markstack_ptr > SP) {
I32 items;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
LEAVE; /* exit outer scope */
(void)POPMARK; /* pop src */
SP = PL_stack_base + POPMARK; /* pop original mark */
if (gimme == G_SCALAR) {
if (PL_op->op_private & OPpGREP_LEX) {
- SV* sv = sv_newmortal();
+ SV* const sv = sv_newmortal();
sv_setiv(sv, items);
PUSHs(sv);
}
register PERL_CONTEXT *cx;
SV *sv;
+ if (CxMULTICALL(&cxstack[cxstack_ix]))
+ return 0;
+
POPBLOCK(cx,newpm);
cxstack_ix++; /* temporarily protect top context */
register PERL_CONTEXT *cx;
SV *sv;
+ if (CxMULTICALL(&cxstack[cxstack_ix]))
+ return 0;
+
POPBLOCK(cx,newpm);
cxstack_ix++; /* temporarily protect top context */
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);
STATIC CV *
S_get_db_sub(pTHX_ SV **svp, CV *cv)
{
- SV *dbsv = GvSV(PL_DBsub);
+ SV *dbsv = GvSVn(PL_DBsub);
save_item(dbsv);
if (!PERLDB_SUB_NN) {
&& (gv = (GV*)*svp) ))) {
/* Use GV from the stack as a fallback. */
/* GV is potentially non-unique, or contain different CV. */
- SV *tmp = newRV((SV*)cv);
+ SV * const tmp = newRV((SV*)cv);
sv_setsv(dbsv, tmp);
SvREFCNT_dec(tmp);
}
}
got_rv:
{
- SV **sp = &sv; /* Used in tryAMAGICunDEREF macro. */
+ SV * const * sp = &sv; /* Used in tryAMAGICunDEREF macro. */
tryAMAGICunDEREF(to_cv);
}
cv = (CV*)SvRV(sv);
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;
return NORMAL;
}
+ /*NOTREACHED*/
assert (0); /* Cannot get here. */
/* This is deliberately moved here as spaghetti code to keep it out of the
hot path. */
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);
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);
PP(pp_method)
{
dSP;
- SV* sv = TOPs;
+ SV* const sv = TOPs;
if (SvROK(sv)) {
- SV* rsv = SvRV(sv);
+ SV* const rsv = SvRV(sv);
if (SvTYPE(rsv) == SVt_PVCV) {
SETs(rsv);
RETURN;
PP(pp_method_named)
{
dSP;
- SV* sv = cSVOP_sv;
+ SV* const sv = cSVOP_sv;
U32 hash = SvSHARED_HASH(sv);
XPUSHs(method_common(sv, &hash));
STATIC SV *
S_method_common(pTHX_ SV* meth, U32* hashp)
{
- SV* sv;
SV* ob;
GV* gv;
HV* stash;
STRLEN namelen;
- const char* packname = 0;
+ const char* packname = Nullch;
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 (SvGMAGICAL(sv))
- mg_get(sv);
+ SvGETMAGIC(sv);
if (SvROK(sv))
ob = (SV*)SvRV(sv);
else {
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) {
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);
https://perl5.git.perl.org / perl5.git / blobdiff