Repost of fork() debugger patch

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

diff --git a/pp_ctl.c b/pp_ctl.c
index c14c2c3..df28463 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -94,7 +94,7 @@ PP(pp_regcomp) {
        pm->op_pmflags |= PMf_WHITE;
 
     if (pm->op_pmflags & PMf_KEEP) {
-       pm->op_pmflags &= ~PMf_RUNTIME; /* no point compiling again */
+       pm->op_private &= ~OPpRUNTIME;  /* no point compiling again */
        hoistmust(pm);
        cLOGOP->op_first->op_next = op->op_next;
     }
@@ -112,6 +112,8 @@ PP(pp_substcont)
     char *orig = cx->sb_orig;
     register REGEXP *rx = cx->sb_rx;
 
+    rxres_restore(&cx->sb_rxres, rx);
+
     if (cx->sb_iters++) {
        if (cx->sb_iters > cx->sb_maxiters)
            DIE("Substitution loop");
@@ -157,9 +159,75 @@ PP(pp_substcont)
     sv_catpvn(dstr, s, m-s);
     cx->sb_s = rx->endp[0];
     cx->sb_rxtainted |= rx->exec_tainted;
+    rxres_save(&cx->sb_rxres, rx);
     RETURNOP(pm->op_pmreplstart);
 }
 
+void
+rxres_save(rsp, rx)
+void **rsp;
+REGEXP *rx;
+{
+    UV *p = (UV*)*rsp;
+    U32 i;
+
+    if (!p || p[1] < rx->nparens) {
+       i = 6 + rx->nparens * 2;
+       if (!p)
+           New(501, p, i, UV);
+       else
+           Renew(p, i, UV);
+       *rsp = (void*)p;
+    }
+
+    *p++ = (UV)rx->subbase;
+    rx->subbase = Nullch;
+
+    *p++ = rx->nparens;
+
+    *p++ = (UV)rx->subbeg;
+    *p++ = (UV)rx->subend;
+    for (i = 0; i <= rx->nparens; ++i) {
+       *p++ = (UV)rx->startp[i];
+       *p++ = (UV)rx->endp[i];
+    }
+}
+
+void
+rxres_restore(rsp, rx)
+void **rsp;
+REGEXP *rx;
+{
+    UV *p = (UV*)*rsp;
+    U32 i;
+
+    Safefree(rx->subbase);
+    rx->subbase = (char*)(*p);
+    *p++ = 0;
+
+    rx->nparens = *p++;
+
+    rx->subbeg = (char*)(*p++);
+    rx->subend = (char*)(*p++);
+    for (i = 0; i <= rx->nparens; ++i) {
+       rx->startp[i] = (char*)(*p++);
+       rx->endp[i] = (char*)(*p++);
+    }
+}
+
+void
+rxres_free(rsp)
+void **rsp;
+{
+    UV *p = (UV*)*rsp;
+
+    if (p) {
+       Safefree((char*)(*p));
+       Safefree(p);
+       *rsp = Null(void*);
+    }
+}
+
 PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;
@@ -656,7 +724,7 @@ PP(pp_sort)
                cx->blk_gimme = G_SCALAR;
                PUSHSUB(cx);
                if (!CvDEPTH(cv))
-                   SvREFCNT_inc(cv);   /* in preparation for POPSUB */
+                   (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
            }
            sortcxix = cxstack_ix;
 
@@ -705,6 +773,7 @@ PP(pp_flip)
            sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
            if (op->op_flags & OPf_SPECIAL) {
                sv_setiv(targ, 1);
+               SETs(targ);
                RETURN;
            }
            else {
@@ -926,11 +995,14 @@ I32 cxix;
     I32 optype;
 
     while (cxstack_ix > cxix) {
-       cx = &cxstack[cxstack_ix--];
-       DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
-                   block_type[cx->cx_type]));
+       cx = &cxstack[cxstack_ix];
+       DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
+                             (long) cxstack_ix+1, block_type[cx->cx_type]));
        /* Note: we don't need to restore the base context info till the end. */
        switch (cx->cx_type) {
+       case CXt_SUBST:
+           POPSUBST(cx);
+           continue;  /* not break */
        case CXt_SUB:
            POPSUB(cx);
            break;
@@ -941,9 +1013,9 @@ I32 cxix;
            POPLOOP(cx);
            break;
        case CXt_NULL:
-       case CXt_SUBST:
            break;
        }
+       cxstack_ix--;
     }
 }
 
@@ -2190,6 +2262,9 @@ PP(pp_require)
 #ifdef DOSISH
       || (name[0] && name[1] == ':')
 #endif
+#ifdef WIN32
+      || (name[0] == '\\' && name[1] == '\\')  /* UNC path */
+#endif
 #ifdef VMS
        || (strchr(name,':')  || ((*name == '[' || *name == '<') &&
            (isALNUM(name[1]) || strchr("$-_]>",name[1]))))
@@ -2235,10 +2310,21 @@ PP(pp_require)
     if (!tryrsfp) {
        if (op->op_type == OP_REQUIRE) {
            SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name));
+           SV *dirmsgsv = NEWSV(0, 0);
+           AV *ar = GvAVn(incgv);
+           I32 i;
            if (instr(SvPVX(msg), ".h "))
                sv_catpv(msg, " (change .h to .ph maybe?)");
            if (instr(SvPVX(msg), ".ph "))
                sv_catpv(msg, " (did you run h2ph?)");
+           sv_catpv(msg, " (@INC contains:");
+           for (i = 0; i <= AvFILL(ar); i++) {
+               char *dir = SvPVx(*av_fetch(ar, i, TRUE), na);
+               sv_setpvf(dirmsgsv, " %s", dir);
+               sv_catsv(msg, dirmsgsv);
+           }
+           sv_catpvn(msg, ")", 1);
+           SvREFCNT_dec(dirmsgsv);
            DIE("%_", msg);
        }
 
@@ -2325,7 +2411,8 @@ PP(pp_entereval)
        save_lines(GvAV(compiling.cop_filegv), linestr);
     PUTBACK;
     ret = doeval(gimme);
-    if (perldb && was != sub_generation) { /* Some subs defined here. */
+    if (perldb && was != sub_generation /* Some subs defined here. */
+       && ret != op->op_next) {        /* Successive compilation. */
        strcpy(safestr, "_<(eval )");   /* Anything fake and short. */
     }
     return DOCATCH(ret);