if (!SvTRUE(TOPs))
RETURN;
else {
- --SP;
+ if (PL_op->op_type == OP_AND)
+ --SP;
RETURNOP(cLOGOP->op_other);
}
}
dPOPTOPssrl;
bool lbyte;
STRLEN rlen;
- const char *rpv = SvPV_const(right, rlen); /* mg_get(right) happens here */
- const bool rbyte = !DO_UTF8(right);
+ const char *rpv;
+ bool rbyte;
bool rcopied = FALSE;
if (TARG == right && right != left) {
+ /* mg_get(right) may happen here ... */
+ rpv = SvPV_const(right, rlen);
+ rbyte = !DO_UTF8(right);
right = sv_2mortal(newSVpvn(rpv, rlen));
rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */
rcopied = TRUE;
SvUTF8_off(TARG);
}
+ /* or mg_get(right) may happen here */
+ if (!rcopied) {
+ rpv = SvPV_const(right, rlen);
+ rbyte = !DO_UTF8(right);
+ }
if (lbyte != rbyte) {
if (lbyte)
sv_utf8_upgrade_nomg(TARG);
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 (%s) in pp_defined()", OP_NAME(PL_op));
- 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:
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;
}
if (SvRMAGICAL(av)) {
U32 i;
for (i=0; i < (U32)maxarg; i++) {
- SV **svp = av_fetch(av, i, FALSE);
+ SV ** const svp = av_fetch(av, i, FALSE);
/* See note in pp_helem, and bug id #27839 */
SP[i+1] = svp
? SvGMAGICAL(*svp) ? sv_mortalcopy(*svp) : *svp
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);
rx->subbeg = (char *) truebase;
rx->startp[0] = s - truebase;
if (RX_MATCH_UTF8(rx)) {
- char *t = (char*)utf8_hop((U8*)s, rx->minlen);
+ char * const t = (char*)utf8_hop((U8*)s, rx->minlen);
rx->endp[0] = t - truebase;
}
else {
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",
RETPUSHNO;
if (SvMAGICAL(av) || AvREIFY(av)) {
- SV **svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
- if (svp)
- sv = *svp;
- else
- sv = Nullsv;
+ SV ** const svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
+ sv = svp ? *svp : Nullsv;
}
else {
sv = AvARRAY(av)[cx->blk_loop.iterix--];
RETPUSHNO;
if (SvMAGICAL(av) || AvREIFY(av)) {
- SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
- if (svp)
- sv = *svp;
- else
- sv = Nullsv;
+ SV ** const svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
+ sv = svp ? *svp : Nullsv;
}
else {
sv = AvARRAY(av)[++cx->blk_loop.iterix];
}
}
- if (sv && SvREFCNT(sv) == 0) {
+ if (sv && SvIS_FREED(sv)) {
*itersvp = Nullsv;
Perl_croak(aTHX_ "Use of freed value in iteration");
}
register REGEXP *rx = PM_GETRE(pm);
STRLEN len;
int force_on_match = 0;
- I32 oldsave = PL_savestack_ix;
+ const I32 oldsave = PL_savestack_ix;
STRLEN slen;
bool doutf8 = FALSE;
#ifdef PERL_OLD_COPY_ON_WRITE
/* 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 */
STATIC CV *
S_get_db_sub(pTHX_ SV **svp, CV *cv)
{
- SV *dbsv = GvSVn(PL_DBsub);
+ SV * const dbsv = GvSVn(PL_DBsub);
save_item(dbsv);
if (!PERLDB_SUB_NN) {
/* This path taken at least 75% of the time */
dMARK;
register I32 items = SP - MARK;
- AV* padlist = CvPADLIST(cv);
+ AV* const padlist = CvPADLIST(cv);
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
cx->blk_sub.retop = PL_op->op_next;
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
if (hasargs)
{
- AV* av;
-#if 0
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p entersub preparing @_\n", thr));
-#endif
- av = (AV*)PAD_SVl(0);
+ AV* const av = (AV*)PAD_SVl(0);
if (AvREAL(av)) {
/* @_ is normally not REAL--this should only ever
* happen when DB::sub() calls things that modify @_ */
SV** svp;
SV* const elemsv = POPs;
IV elem = SvIV(elemsv);
- AV* av = (AV*)POPs;
+ AV* const av = (AV*)POPs;
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
SV *sv;
https://perl5.git.perl.org / perl5.git / blobdiff