if (!SvTRUE(TOPs))
RETURN;
else {
- --SP;
+ if (PL_op->op_type == OP_AND)
+ --SP;
RETURNOP(cLOGOP->op_other);
}
}
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)
}
}
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;
}
const U8 *f;
if (ckWARN(WARN_UTF8) &&
- !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",
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 */