In makedef.pl, move handling of $ARGS{TARG_DIR} to the open statements.

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 63efd9a..dc1b055 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -43,13 +43,20 @@ PP(pp_wantarray)
     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:
@@ -1950,7 +1957,7 @@ PP(pp_caller)
        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)
@@ -2366,7 +2373,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                    assert(cx->blk_sub.retop->op_type == OP_RV2HV);
                    deref_type = OPpDEREF_HV;
                }
-               vivify_ref(TOPs, deref_type);
+               TOPs = vivify_ref(TOPs, deref_type);
            }
        }
     }
@@ -2416,7 +2423,6 @@ PP(pp_return)
     bool popsub2 = FALSE;
     bool clear_errsv = FALSE;
     bool lval = FALSE;
-    bool gmagic = FALSE;
     I32 gimme;
     SV **newsp;
     PMOP *newpm;
@@ -2459,7 +2465,6 @@ PP(pp_return)
        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:
@@ -2505,12 +2510,10 @@ PP(pp_return)
                        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);
@@ -3471,6 +3474,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     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));
@@ -3522,11 +3526,13 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 
     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);
 
@@ -3586,15 +3592,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     } 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: */
@@ -4181,14 +4178,14 @@ PP(pp_entereval)
     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);