dVAR;
dSP;
I32 cxix;
+ const PERL_CONTEXT *cx;
EXTEND(SP, 1);
- cxix = dopoptosub(cxstack_ix);
- if (cxix < 0)
+ if (PL_op->op_private & OPpOFFBYONE) {
+ if (!(cx = caller_cx(1,NULL))) RETPUSHUNDEF;
+ }
+ else {
+ cxix = dopoptosub(cxstack_ix);
+ if (cxix < 0)
RETPUSHUNDEF;
+ cx = &cxstack[cxix];
+ }
- switch (cxstack[cxix].blk_gimme) {
+ switch (cx->blk_gimme) {
case G_ARRAY:
RETPUSHYES;
case G_SCALAR:
AV * const ary = cx->blk_sub.argarray;
const int off = AvARRAY(ary) - AvALLOC(ary);
- if (!PL_dbargs)
+ if (!PL_dbargs || AvREAL(PL_dbargs))
Perl_init_dbargs(aTHX);
if (AvMAX(PL_dbargs) < AvFILLp(ary) + off)
assert(cx->blk_sub.retop->op_type == OP_RV2HV);
deref_type = OPpDEREF_HV;
}
- vivify_ref(TOPs, deref_type);
+ TOPs = vivify_ref(TOPs, deref_type);
}
}
}
bool popsub2 = FALSE;
bool clear_errsv = FALSE;
bool lval = FALSE;
- bool gmagic = FALSE;
I32 gimme;
SV **newsp;
PMOP *newpm;
popsub2 = TRUE;
lval = !!CvLVALUE(cx->blk_sub.cv);
retop = cx->blk_sub.retop;
- gmagic = CxLVAL(cx) & OPpENTERSUB_DEREF;
cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
break;
case CXt_EVAL:
FREETMPS;
*++newsp = sv_mortalcopy(sv);
SvREFCNT_dec(sv);
- if (gmagic) SvGETMAGIC(sv);
}
}
else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1) {
*++newsp = *SP;
- if (gmagic) SvGETMAGIC(*SP);
}
else
*++newsp = sv_mortalcopy(*SP);
CvEVAL_on(PL_compcv);
assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
+ cxstack[cxstack_ix].blk_gimme = gimme;
CvOUTSIDE_SEQ(PL_compcv) = seq;
CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
if (yystatus || PL_parser->error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
- PERL_CONTEXT *cx = NULL;
+ PERL_CONTEXT *cx;
I32 optype; /* Used by POPEVAL. */
- SV *namesv = NULL;
+ SV *namesv;
const char *msg;
+ cx = NULL;
+ namesv = NULL;
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(optype);
} else
SAVEFREEOP(PL_eval_root);
- /* Set the context for this new optree.
- * Propagate the context from the eval(). */
- if ((gimme & G_WANT) == G_VOID)
- scalarvoid(PL_eval_root);
- else if ((gimme & G_WANT) == G_ARRAY)
- list(PL_eval_root);
- else
- scalar(PL_eval_root);
-
DEBUG_x(dump_eval());
/* Register with debugger: */
SAVECOMPILEWARNINGS();
PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
cophh_free(CopHINTHASH_get(&PL_compiling));
- if (Perl_fetch_cop_label(aTHX_ PL_curcop, NULL, NULL)) {
+ if (Perl_cop_fetch_label(aTHX_ PL_curcop, NULL, NULL)) {
/* The label, if present, is the first entry on the chain. So rather
than writing a blank label in front of it (which involves an
allocation), just use the next entry in the chain. */
PL_compiling.cop_hints_hash
= cophh_copy(PL_curcop->cop_hints_hash->refcounted_he_next);
/* Check the assumption that this removed the label. */
- assert(Perl_fetch_cop_label(aTHX_ &PL_compiling, NULL, NULL) == NULL);
+ assert(Perl_cop_fetch_label(aTHX_ &PL_compiling, NULL, NULL) == NULL);
}
else
PL_compiling.cop_hints_hash = cophh_copy(PL_curcop->cop_hints_hash);
I32 gimme;
SV **newsp;
PMOP *newpm;
+
+ PERL_UNUSED_VAR(gimme);
cxix = dopoptowhen(cxstack_ix);
if (cxix < 0)