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

diff --git a/cop.h b/cop.h
index 457aeb4..ea846ab 100644 (file)
--- 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 0bb828f..a117b7b 100644 (file)
--- 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 5f3ca18..5e45a9c 100644 (file)
--- 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 a155177..1dc2a23 100755 (executable)
--- 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 d613c8e..f4af3e9 100644 (file)
--- 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;
        }