fix POPSTACK panics that ensued from bad interaction between

runlevels and stack of stacks (change#3988 done right);
basically, we pop the runlevel if the stacklevel is not the
same one we started the runlevel with

p4raw-link: @3988 on //depot/perl: a7c6d24429ab2b6db54575a3bdc62c7ed9f881cf

p4raw-id: //depot/perl@4376

5 files changed, 19 insertions, 15 deletions

diff --git a/cop.h b/cop.h
index 457aeb4fab..ea846ab58b 100644
--- a/cop.h
+++ b/cop.h
@@ -296,7 +296,6 @@ struct context {
 #define G_NOARGS	8	/* Don't construct a @_ array. */
 #define G_KEEPERR      16	/* Append errors to $@, don't overwrite it */
 #define G_NODEBUG      32	/* Disable debugging at toplevel.  */
-#define G_NOCATCH      64       /* Don't do CATCH_SET() */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL	0	/* not in an eval */
diff --git a/perl.c b/perl.c
index 0bb828fb7a..a117b7b103 100644
--- a/perl.c
+++ b/perl.c
@@ -1241,16 +1241,10 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	PL_op->op_private |= OPpENTERSUB_DB;
 
     if (!(flags & G_EVAL)) {
-        /* G_NOCATCH is a hack for perl_vdie using this path to call
-	   a __DIE__ handler */
-        if (!(flags & G_NOCATCH)) {
-	    CATCH_SET(TRUE);
-	}
+	CATCH_SET(TRUE);
 	call_xbody((OP*)&myop, FALSE);
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
-        if (!(flags & G_NOCATCH)) {
-	    CATCH_SET(FALSE);
-	}
+	CATCH_SET(FALSE);
     }
     else {
 	cLOGOP->op_other = PL_op;
diff --git a/pp_ctl.c b/pp_ctl.c
index 5f3ca18667..5e45a9c48f 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2436,6 +2436,7 @@ S_docatch(pTHX_ OP *o)
     dTHR;
     int ret;
     OP *oldop = PL_op;
+    volatile PERL_SI *cursi = PL_curstackinfo;
     dJMPENV;
 
 #ifdef DEBUGGING
@@ -2448,7 +2449,7 @@ S_docatch(pTHX_ OP *o)
     case 0:
 	break;
     case 3:
-	if (PL_restartop) {
+	if (PL_restartop && cursi == PL_curstackinfo) {
 	    PL_op = PL_restartop;
 	    PL_restartop = 0;
 	    goto redo_body;
diff --git a/t/op/runlevel.t b/t/op/runlevel.t
index a1551775e3..1dc2a234b2 100755
--- a/t/op/runlevel.t
+++ b/t/op/runlevel.t
@@ -335,3 +335,17 @@ tie my @bar, 'TEST';
 print join('|', @bar[0..3]), "\n"; 
 EXPECT
 foo|fee|fie|foe
+########
+package TH;
+sub TIEHASH { bless {}, TH }
+sub STORE { eval { print "@_[1,2]\n" }; die "bar\n" }
+tie %h, TH;
+eval { $h{A} = 1; print "never\n"; };
+print $@;
+eval { $h{B} = 2; };
+print $@;
+EXPECT
+A 1
+bar
+B 2
+bar
diff --git a/util.c b/util.c
index d613c8edeb..f4af3e936d 100644
--- a/util.c
+++ b/util.c
@@ -1495,11 +1495,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
 	    PUSHMARK(SP);
 	    XPUSHs(msg);
 	    PUTBACK;
-	    /* HACK - REVISIT - avoid CATCH_SET(TRUE) in call_sv()
-	       or we come back here due to a JMPENV_JMP() and do 
-	       a POPSTACK - but die_where() will have already done 
-	       one as it unwound - NI-S 1999/08/14 */
-	    call_sv((SV*)cv, G_DISCARD|G_NOCATCH);
+	    call_sv((SV*)cv, G_DISCARD);
 	    POPSTACK;
 	    LEAVE;
 	}