New lightweight Carp has a require. If Carp is used in a __DIE__ handler

this causes a POPSTACK panic. The problem seems to be that although
die_where() has unwound the tail of perl_vdie() top_env setjmp has been
set to resume execution there. Avoiding setting CATCH_SET(TRUE) in
call_sv() avoids this. So invent a new G_NOCATCH flag to disable
messing with CATCH_SET() in call_sv, use it in perl_vdie().
Add test to op/eval.t which will fail (panic) if bug comes back.
>>> I AM NOT CONVINCED THIS IS CORRECT LONG TERM FIX <<<

p4raw-id: //depot/perl@3988

diff --git a/cop.h b/cop.h
index 84afd58..f23251b 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -297,6 +297,7 @@ 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 d811879..8c8b84c 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1225,10 +1225,16 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        PL_op->op_private |= OPpENTERSUB_DB;
 
     if (!(flags & G_EVAL)) {
-       CATCH_SET(TRUE);
+        /* G_NOCATCH is a hack for perl_vdie using this path to call
+          a __DIE__ handler */
+        if (!(flags & G_NOCATCH)) {
+           CATCH_SET(TRUE);
+       }
        call_xbody((OP*)&myop, FALSE);
        retval = PL_stack_sp - (PL_stack_base + oldmark);
-       CATCH_SET(FALSE);
+        if (!(flags & G_NOCATCH)) {
+           CATCH_SET(FALSE);
+       }
     }
     else {
        cLOGOP->op_other = PL_op;

diff --git a/t/op/eval.t b/t/op/eval.t
index dc163e9..abcb379 100755 (executable)
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..36\n";
+print "1..37\n";
 
 eval 'print "ok 1\n";';
 
@@ -171,3 +171,8 @@ sub terminal { eval 'print $r' }
 }
 $x++;
 
+# Have we cured panic which occurred with require/eval in die handler ?
+$SIG{__DIE__} = sub { eval {1}; die shift }; 
+eval { die "ok ".$x++,"\n" }; 
+print $@;
+

diff --git a/util.c b/util.c
index 132ec5e..715a5f1 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1491,7 +1491,11 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
            PUSHMARK(SP);
            XPUSHs(msg);
            PUTBACK;
-           call_sv((SV*)cv, G_DISCARD);
+           /* 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);
            POPSTACK;
            LEAVE;
        }