Integrate from maint-5.8 : changes 18290-1, 18293-5, 18297

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index a91eb38..2bebcbc 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1690,11 +1690,11 @@ PP(pp_enteriter)
        cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
        if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
            dPOPss;
+           /* See comment in pp_flop() */
            if (SvNIOKp(sv) || !SvPOKp(sv) ||
                SvNIOKp(cx->blk_loop.iterary) || !SvPOKp(cx->blk_loop.iterary) ||
                (looks_like_number(sv) && *SvPVX(sv) != '0' &&
-                looks_like_number((SV*)cx->blk_loop.iterary) &&
-                *SvPVX(cx->blk_loop.iterary) != '0'))
+                looks_like_number((SV*)cx->blk_loop.iterary)))
            {
                 if (SvNV(sv) < IV_MIN ||
                     SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
@@ -2572,6 +2572,8 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
     char tbuf[TYPE_DIGITS(long) + 12 + 10];
     char *tmpbuf = tbuf;
     char *safestr;
+    int runtime;
+    CV* runcv;
 
     ENTER;
     lex_start(sv);
@@ -2610,12 +2612,21 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
 #endif
     PL_hints &= HINT_UTF8;
 
+    /* we get here either during compilation, or via pp_regcomp at runtime */
+    runtime = PL_op && (PL_op->op_type == OP_REGCOMP);
+    if (runtime)
+       runcv = find_runcv();
+
     PL_op = &dummy;
     PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;                       /* Avoid uninit warning. */
     PUSHBLOCK(cx, CXt_EVAL|(PL_curcop == &PL_compiling ? 0 : CXp_REAL), SP);
     PUSHEVAL(cx, 0, Nullgv);
-    rop = doeval(G_SCALAR, startop);
+
+    if (runtime)
+       rop = doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
+    else
+       rop = doeval(G_SCALAR, startop, PL_compcv, PL_cop_seqmax);
     POPBLOCK(cx,PL_curpm);
     POPEVAL(cx);
 
@@ -2633,14 +2644,47 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
     return rop;
 }
 
+
+/*
+=for apidoc find_runcv
+
+Locate the CV corresponding to the currently executing sub or eval.
+
+=cut
+*/
+
+CV*
+Perl_find_runcv(pTHX)
+{
+    I32                 ix;
+    PERL_SI     *si;
+    PERL_CONTEXT *cx;
+
+    for (si = PL_curstackinfo; si; si = si->si_prev) {
+       for (ix = si->si_cxix; ix >= 0; ix--) {
+           cx = &(si->si_cxstack[ix]);
+           if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
+               return cx->blk_sub.cv;
+           else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
+               return PL_compcv;
+       }
+    }
+    return PL_main_cv;
+}
+
+
+/* Compile a require/do, an eval '', or a /(?{...})/.
+ * In the last case, startop is non-null, and contains the address of
+ * a pointer that should be set to the just-compiled code.
+ * outside is the lexically enclosing CV (if any) that invoked us.
+ */
+
 /* With USE_5005THREADS, eval_owner must be held on entry to doeval */
 STATIC OP *
-S_doeval(pTHX_ int gimme, OP** startop)
+S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 {
     dSP;
     OP *saveop = PL_op;
-    CV *caller;
-    I32 i;
 
     PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
                  ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
@@ -2648,17 +2692,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
 
     PUSHMARK(SP);
 
-    caller = PL_compcv;
-    for (i = cxstack_ix - 1; i >= 0; i--) {
-       PERL_CONTEXT *cx = &cxstack[i];
-       if (CxTYPE(cx) == CXt_EVAL)
-           break;
-       else if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
-           caller = cx->blk_sub.cv;
-           break;
-       }
-    }
-
     SAVESPTR(PL_compcv);
     PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)PL_compcv, SVt_PVCV);
@@ -2666,15 +2699,13 @@ S_doeval(pTHX_ int gimme, OP** startop)
     assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
     cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
 
+    CvOUTSIDE_SEQ(PL_compcv) = seq;
+    CvOUTSIDE(PL_compcv) = outside ? (CV*)SvREFCNT_inc(outside) : outside;
+
     /* set up a scratch pad */
 
     CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
 
-    if (!saveop ||
-       (saveop->op_type != OP_REQUIRE && saveop->op_type != OP_DOFILE))
-    {
-       CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller);
-    }
 
     SAVEMORTALIZESV(PL_compcv);        /* must remain until end of current statement */
 
@@ -2732,13 +2763,17 @@ S_doeval(pTHX_ int gimme, OP** startop)
            Perl_croak(aTHX_ "%sCompilation failed in regexp",
                       (*msg ? msg : "Unknown error\n"));
        }
+       else {
+           char* msg = SvPVx(ERRSV, n_a);
+           if (!*msg) {
+               sv_setpv(ERRSV, "Compilation error");
+           }
+       }
        RETPUSHUNDEF;
     }
     CopLINE_set(&PL_compiling, 0);
     if (startop) {
        *startop = PL_eval_root;
-       SvREFCNT_dec(CvOUTSIDE(PL_compcv));
-       CvOUTSIDE(PL_compcv) = Nullcv;
     } else
        SAVEFREEOP(PL_eval_root);
     if (gimme & G_VOID)
@@ -3162,7 +3197,7 @@ PP(pp_require)
     encoding = PL_encoding;
     PL_encoding = Nullsv;
 
-    op = DOCATCH(doeval(gimme, NULL));
+    op = DOCATCH(doeval(gimme, NULL, Nullcv, PL_curcop->cop_seq));
     
     /* Restore encoding. */
     PL_encoding = encoding;
@@ -3186,6 +3221,7 @@ PP(pp_entereval)
     char *safestr;
     STRLEN len;
     OP *ret;
+    CV* runcv;
 
     if (!SvPV(sv,len))
        RETPUSHUNDEF;
@@ -3233,6 +3269,7 @@ PP(pp_entereval)
         PL_compiling.cop_io = newSVsv(PL_curcop->cop_io);
         SAVEFREESV(PL_compiling.cop_io);
     }
+    runcv = find_runcv();
 
     push_return(PL_op->op_next);
     PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
@@ -3243,7 +3280,7 @@ PP(pp_entereval)
     if (PERLDB_LINE && PL_curstash != PL_debstash)
        save_lines(CopFILEAV(&PL_compiling), PL_linestr);
     PUTBACK;
-    ret = doeval(gimme, NULL);
+    ret = doeval(gimme, NULL, runcv, PL_curcop->cop_seq);
     if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
        && ret != PL_op->op_next) {     /* Successive compilation. */
        strcpy(safestr, "_<(eval )");   /* Anything fake and short. */