Clean up and document API for hashes

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

diff --git a/pp_ctl.c b/pp_ctl.c
index be49bca..6eab4da 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -23,6 +23,9 @@
 #define WORD_ALIGN sizeof(U16)
 #endif
 
+#define DOCATCH(o) (mustcatch ? docatch(o) : (o))
+
+static OP *docatch _((OP *o));
 static OP *doeval _((int gimme));
 static OP *dofindlabel _((OP *op, char *label, OP **opstack));
 static void doparseform _((SV *sv));
@@ -123,6 +126,8 @@ PP(pp_substcont)
            SV *targ = cx->sb_targ;
            sv_catpvn(dstr, s, cx->sb_strend - s);
 
+           TAINT_IF(cx->sb_rxtainted || rx->exec_tainted);
+
            (void)SvOOK_off(targ);
            Safefree(SvPVX(targ));
            SvPVX(targ) = SvPVX(dstr);
@@ -133,8 +138,7 @@ PP(pp_substcont)
 
            (void)SvPOK_only(targ);
            SvSETMAGIC(targ);
-           if (cx->sb_rxtainted)
-               SvTAINTED_on(targ);
+           SvTAINT(targ);
            PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
            LEAVE_SCOPE(cx->sb_oldsave);
            POPSUBST(cx);
@@ -624,6 +628,7 @@ PP(pp_sort)
            AV *oldstack;
            CONTEXT *cx;
            SV** newsp;
+           bool oldmustcatch = mustcatch;
 
            SAVETMPS;
            SAVESPTR(op);
@@ -634,6 +639,7 @@ PP(pp_sort)
                AvREAL_off(sortstack);
                av_extend(sortstack, 32);
            }
+           mustcatch = TRUE;
            SWITCHSTACK(curstack, sortstack);
            if (sortstash != stash) {
                firstgv = gv_fetchpv("a", TRUE, SVt_PV);
@@ -650,6 +656,7 @@ PP(pp_sort)
 
            POPBLOCK(cx,curpm);
            SWITCHSTACK(sortstack, oldstack);
+           mustcatch = oldmustcatch;
        }
        LEAVE;
     }
@@ -1853,8 +1860,13 @@ PP(pp_exit)
 
     if (MAXARG < 1)
        anum = 0;
-    else
+    else {
        anum = SvIVx(POPs);
+#ifdef VMSISH_EXIT
+       if (anum == 1 && VMSISH_EXIT)
+           anum = 0;
+#endif
+    }
     my_exit(anum);
     PUSHs(&sv_undef);
     RETURN;
@@ -1929,6 +1941,46 @@ SV *sv;
 }
 
 static OP *
+docatch(o)
+OP *o;
+{
+    int ret;
+    int oldrunlevel = runlevel;
+    Sigjmp_buf oldtop;
+
+    op = o;
+    runlevel--;                                /* pretense */
+    Copy(top_env, oldtop, 1, Sigjmp_buf);
+#ifdef DEBUGGING
+    assert(mustcatch == TRUE);
+#endif
+    mustcatch = FALSE;
+    switch ((ret = Sigsetjmp(top_env,1))) {
+    default:                           /* topmost level handles it */
+       Copy(oldtop, top_env, 1, Sigjmp_buf);
+       runlevel = oldrunlevel;
+       mustcatch = TRUE;
+       Siglongjmp(top_env, ret);
+       /* NOTREACHED */
+    case 3:
+       if (!restartop) {
+           PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+           break;
+       }
+       op = restartop;
+       restartop = 0;
+       /* FALL THROUGH */
+    case 0:
+        runops();
+       break;
+    }
+    Copy(oldtop, top_env, 1, Sigjmp_buf);
+    runlevel = oldrunlevel;
+    mustcatch = TRUE;
+    return Nullop;
+}
+
+static OP *
 doeval(gimme)
 int gimme;
 {
@@ -2171,7 +2223,7 @@ PP(pp_require)
     compiling.cop_line = 0;
 
     PUTBACK;
-    return doeval(G_SCALAR);
+    return DOCATCH(doeval(G_SCALAR));
 }
 
 PP(pp_dofile)
@@ -2226,7 +2278,7 @@ PP(pp_entereval)
     if (perldb && was != sub_generation) { /* Some subs defined here. */
        strcpy(safestr, "_<(eval )");   /* Anything fake and short. */
     }
-    return ret;
+    return DOCATCH(ret);
 }
 
 PP(pp_leaveeval)
@@ -2310,7 +2362,8 @@ PP(pp_entertry)
 
     in_eval = 1;
     sv_setpv(GvSV(errgv),"");
-    RETURN;
+    PUTBACK;
+    return DOCATCH(op->op_next);
 }
 
 PP(pp_leavetry)