summaryrefslogtreecommitdiff
path: root/pp_ctl.c
diff options
context:
space:
mode:
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>1997-02-25 13:12:02 +1200
committerChip Salzenberg <chip@atlantic.net>1997-02-25 13:12:02 +1200
commit1e422769b80038b1bfc4f5af33438b87cc1c7a22 (patch)
tree0f5d892c1c73cebd66d4336f658f001935d92898 /pp_ctl.c
parent2f9daededa74ef1264bd2c46743008f84bff0cfc (diff)
downloadperl-1e422769b80038b1bfc4f5af33438b87cc1c7a22.tar.gz
[inseparable changes from match from perl-5.003_90 to perl-5.003_91]
BUILD PROCESS Subject: Sanity check linking with $libs Date: Tue, 25 Feb 1997 14:13:45 -0500 (EST) From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> Files: Configure Msg-ID: <Pine.SOL.3.95q.970225221634.2486A-100000@fractal.lafayette.edu> (applied based on p5p patch as commit 5c37e92e59bb92e49d5a21017cd6dc066a28ddea) Subject: Flush stdout when printing $randbits guess From: Chip Salzenberg <chip@perl.com> Files: Configure Subject: Configure changes for Irix nm From: Helmut Jarausch <helmutjarausch@unknown> Files: Configure CORE LANGUAGE CHANGES Subject: Fix perl_call_*() when !G_EVAL Date: Tue, 25 Feb 1997 02:25:56 -0500 From: Gurusamy Sarathy <gsar@engin.umich.edu> Files: MANIFEST gv.c interp.sym perl.c perl.h pp_ctl.c pp_sys.c t/op/runlevel.t Msg-ID: <199702250725.CAA09192@aatma.engin.umich.edu>, <199702251925.OAA15498@aatma.engin.umich.edu>, <199702252200.RAA16853@aatma.engin.umich.edu> (applied based on p5p patch as commits 40f788c454d994616342c409de5b5d181ad9b8af, and 907a881cde89c56bc61d3f314c0efb8754ca472a, 20efc0829f6564c44574762adb07e8865bc14026) Subject: Fix taint tests for writeable dirs in $ENV{PATH} From: Chip Salzenberg <chip@perl.com> Files: mg.c mg.h pod/perlsec.pod taint.c Subject: Forbid tainted parameters for truncate() From: Chip Salzenberg <chip@perl.com> Files: pp_sys.c Subject: Don't taint magic hash keys unnecessarily Date: Fri, 28 Feb 1997 02:11:26 -0500 (EST) From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> Files: hv.c private-msgid: <01IFXL9TY74Y00661G@hmivax.humgen.upenn.edu> CORE PORTABILITY Subject: VMS patches post _90 Date: Fri, 28 Feb 1997 15:26:33 -0500 (EST) From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> Files: doio.c mg.c perl.h pp_hot.c t/op/rand.t t/op/taint.t taint.c vms/descrip.mms vms/vms.c private-msgid: <01IFYDE5ZT7O005A53@hmivax.humgen.upenn.edu> Subject: Fix taint check in system() and exec() under VMS and OS/2 From: Chip Salzenberg <chip@perl.com> Files: pp_sys.c Subject: If _XOPEN_VERSION >= 4, socket length parameters are size_t From: Michael H. Moran <mhm@austin.ibm.com> Files: perl.h pp_sys.c Subject: Make dooneliner() compile again From: Chip Salzenberg <chip@perl.com> Files: pp_sys.c DOCUMENTATION Subject: Move ENVIRONMENT from perl.pod to perlrun.pod From: Chip Salzenberg <chip@perl.com> Files: pod/perl.pod pod/perlrun.pod Subject: Describe PERL_DEBUG_MSTATS in perlrun.pod From: Nat <gnat@frii.com> Files: pod/perlrun.pod Subject: Fix references to perlbug From: Chip Salzenberg <chip@perl.com> Files: pod/perl.pod pod/perldelta.pod pod/perllocale.pod pod/perltoc.pod OTHER CORE CHANGES Subject: Short-circuit duplicate study() calls From: Chip Salzenberg <chip@perl.com> Files: pp.c Subject: Call sv_set[iu]v() with [IU]V parameter, not [IU]32 From: Chip Salzenberg <chip@perl.com> Files: perl.c pp.c pp_sys.c toke.c util.c Subject: Clean up and document API for hashes Date: Tue, 25 Feb 1997 13:24:02 -0500 From: Gurusamy Sarathy <gsar@engin.umich.edu> Files: hv.c hv.h pod/perldelta.pod pod/perlguts.pod Msg-ID: <199702251824.NAA14859@aatma.engin.umich.edu> (applied based on p5p patch as commit a61fe43df197fcc70e6f310c06ee17d52b606c45) Subject: pp_undef was not always freeing memory Date: Thu, 27 Feb 1997 01:53:51 -0500 (EST) From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: pp.c Msg-ID: <199702270653.BAA13949@monk.mps.ohio-state.edu> (applied based on p5p patch as commit 1da885048b65b5be1bd3077c6fc45f92c567e1b5) Subject: Don't examine rx->exec_tainted if pregexec() fails From: Chip Salzenberg <chip@perl.com> Files: pp_hot.c TESTS Subject: New test op/taint.t Date: Tue, 25 Feb 1997 11:36:53 -0800 (PST) From: Tom Phoenix <rootbeer@teleport.com> Files: MANIFEST t/op/taint.t private-msgid: <Pine.GSO.3.95q.970225101328.18288M-100000@kelly.teleport.com Subject: Patch to t/op/rand.t Date: Tue, 25 Feb 1997 18:19:34 -0800 (PST) From: Tom Phoenix <rootbeer@teleport.com> Files: t/op/rand.t private-msgid: <Pine.GSO.3.95q.970225181321.13796Q-100000@kelly.teleport.com UTILITIES Subject: Add --lax option to pod2man; use it in perldoc From: Nat <gnat@frii.com> Files: pod/pod2man.PL utils/perldoc.PL Subject: Eliminate dead code in pod2man From: Chip Salzenberg <chip@perl.com> Files: pod/pod2man.PL
Diffstat (limited to 'pp_ctl.c')
-rw-r--r--pp_ctl.c56
1 files changed, 53 insertions, 3 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index c70375b730..de3c13b472 100644
--- 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));
@@ -625,6 +628,7 @@ PP(pp_sort)
AV *oldstack;
CONTEXT *cx;
SV** newsp;
+ bool oldmustcatch = mustcatch;
SAVETMPS;
SAVESPTR(op);
@@ -635,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);
@@ -651,6 +656,7 @@ PP(pp_sort)
POPBLOCK(cx,curpm);
SWITCHSTACK(sortstack, oldstack);
+ mustcatch = oldmustcatch;
}
LEAVE;
}
@@ -1935,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;
{
@@ -2177,7 +2226,7 @@ PP(pp_require)
compiling.cop_line = 0;
PUTBACK;
- return doeval(G_SCALAR);
+ return DOCATCH(doeval(G_SCALAR));
}
PP(pp_dofile)
@@ -2232,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)
@@ -2316,7 +2365,8 @@ PP(pp_entertry)
in_eval = 1;
sv_setpv(GvSV(errgv),"");
- RETURN;
+ PUTBACK;
+ return DOCATCH(op->op_next);
}
PP(pp_leavetry)