*.pod changes based on the FAQ

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 6baf002..0a01c11 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,6 +1,6 @@
 /*    pp_ctl.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -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;
     }
@@ -791,11 +798,11 @@ char *label;
        case CXt_LOOP:
            if (!cx->blk_loop.label ||
              strNE(label, cx->blk_loop.label) ) {
-               DEBUG_l(deb("(Skipping label #%d %s)\n",
-                       i, cx->blk_loop.label));
+               DEBUG_l(deb("(Skipping label #%ld %s)\n",
+                       (long)i, cx->blk_loop.label));
                continue;
            }
-           DEBUG_l( deb("(Found label #%d %s)\n", i, label));
+           DEBUG_l( deb("(Found label #%ld %s)\n", (long)i, label));
            return i;
        }
     }
@@ -830,7 +837,7 @@ I32 startingblock;
            continue;
        case CXt_EVAL:
        case CXt_SUB:
-           DEBUG_l( deb("(Found sub #%d)\n", i));
+           DEBUG_l( deb("(Found sub #%ld)\n", (long)i));
            return i;
        }
     }
@@ -849,7 +856,7 @@ I32 startingblock;
        default:
            continue;
        case CXt_EVAL:
-           DEBUG_l( deb("(Found eval #%d)\n", i));
+           DEBUG_l( deb("(Found eval #%ld)\n", (long)i));
            return i;
        }
     }
@@ -882,7 +889,7 @@ I32 startingblock;
                warn("Exiting pseudo-block via %s", op_name[op->op_type]);
            return -1;
        case CXt_LOOP:
-           DEBUG_l( deb("(Found loop #%d)\n", i));
+           DEBUG_l( deb("(Found loop #%ld)\n", (long)i));
            return i;
        }
     }
@@ -1120,8 +1127,8 @@ sortcv(a, b)
 const void *a;
 const void *b;
 {
-    SV **str1 = (SV **) a;
-    SV **str2 = (SV **) b;
+    SV * const *str1 = (SV * const *)a;
+    SV * const *str2 = (SV * const *)b;
     I32 oldsaveix = savestack_ix;
     I32 oldscopeix = scopestack_ix;
     I32 result;
@@ -1147,7 +1154,7 @@ sortcmp(a, b)
 const void *a;
 const void *b;
 {
-    return sv_cmp(*(SV **)a, *(SV **)b);
+    return sv_cmp(*(SV * const *)a, *(SV * const *)b);
 }
 
 static int
@@ -1155,7 +1162,7 @@ sortcmp_locale(a, b)
 const void *a;
 const void *b;
 {
-    return sv_cmp_locale(*(SV **)a, *(SV **)b);
+    return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b);
 }
 
 PP(pp_reset)
@@ -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,49 @@ SV *sv;
 }
 
 static OP *
+docatch(o)
+OP *o;
+{
+    int ret;
+    int oldrunlevel = runlevel;
+    OP *oldop = op;
+    Sigjmp_buf oldtop;
+
+    op = o;
+    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;
+       op = oldop;
+       Siglongjmp(top_env, ret);
+       /* NOTREACHED */
+    case 3:
+       if (!restartop) {
+           PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+           break;
+       }
+       mustcatch = FALSE;
+       op = restartop;
+       restartop = 0;
+       /* FALL THROUGH */
+    case 0:
+        runops();
+       break;
+    }
+    Copy(oldtop, top_env, 1, Sigjmp_buf);
+    runlevel = oldrunlevel;
+    mustcatch = TRUE;
+    op = oldop;
+    return Nullop;
+}
+
+static OP *
 doeval(gimme)
 int gimme;
 {
@@ -2171,7 +2226,7 @@ PP(pp_require)
     compiling.cop_line = 0;
 
     PUTBACK;
-    return doeval(G_SCALAR);
+    return DOCATCH(doeval(G_SCALAR));
 }
 
 PP(pp_dofile)
@@ -2200,7 +2255,7 @@ PP(pp_entereval)
     /* switch to eval mode */
 
     SAVESPTR(compiling.cop_filegv);
-    sprintf(tmpbuf, "_<(eval %d)", ++evalseq);
+    sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++evalseq);
     compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
     compiling.cop_line = 1;
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
@@ -2226,7 +2281,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 +2365,8 @@ PP(pp_entertry)
 
     in_eval = 1;
     sv_setpv(GvSV(errgv),"");
-    RETURN;
+    PUTBACK;
+    return DOCATCH(op->op_next);
 }
 
 PP(pp_leavetry)