second attempt to fix [perl #24914] freeing a CV reference that was

currently being executed caused coredumps. The dounwind called by
die unwinds all the contexts on the context stack before unwinding
the save stack.  To stop premature freeing of the CV, hold
references to it on both stacks.

p4raw-id: //depot/perl@22182

diff --git a/cop.h b/cop.h
index 2e30eaf..3d1191c 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -121,11 +121,20 @@ struct block_sub {
     PAD                *oldcomppad;
 };
 
-/* base for the next two macros. Don't use directly */
+/* base for the next two macros. Don't use directly.
+ * Note that the refcnt of the cv is incremented twice;  The CX one is
+ * decremented by LEAVESUB, the other by LEAVE. */
+
 #define PUSHSUB_BASE(cx)                                               \
        cx->blk_sub.cv = cv;                                            \
        cx->blk_sub.olddepth = CvDEPTH(cv);                             \
-       cx->blk_sub.hasargs = hasargs;
+       cx->blk_sub.hasargs = hasargs;                                  \
+       if (!CvDEPTH(cv)) {                                             \
+           (void)SvREFCNT_inc(cv);                                     \
+           (void)SvREFCNT_inc(cv);                                     \
+           SAVEFREESV(cv);                                             \
+       }
+
 
 #define PUSHSUB(cx)                                                    \
        PUSHSUB_BASE(cx)                                                \

diff --git a/pp_ctl.c b/pp_ctl.c
index fe6c9f6..9b2ca63 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1701,7 +1701,6 @@ PP(pp_dbstate)
        PUSHBLOCK(cx, CXt_SUB, SP);
        PUSHSUB_DB(cx);
        CvDEPTH(cv)++;
-       (void)SvREFCNT_inc(cv);
        PAD_SET_CUR(CvPADLIST(cv),1);
        RETURNOP(CvSTART(cv));
     }

diff --git a/pp_hot.c b/pp_hot.c
index 208d89b..1874a14 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2663,9 +2663,7 @@ PP(pp_entersub)
         * Owing the speed considerations, we choose instead to search for
         * the cv using find_runcv() when calling doeval().
         */
-       if (CvDEPTH(cv) < 2)
-           (void)SvREFCNT_inc(cv);
-       else {
+       if (CvDEPTH(cv) >= 2) {
            PERL_STACK_OVERFLOW_CHECK();
            pad_push(padlist, CvDEPTH(cv), 1);
        }

diff --git a/pp_sort.c b/pp_sort.c
index 8fe6bcd..8e6422d 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1524,8 +1524,6 @@ PP(pp_sort)
                cx->cx_type = CXt_SUB;
                cx->blk_gimme = G_SCALAR;
                PUSHSUB(cx);
-               if (!CvDEPTH(cv))
-                   (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
            }
            PL_sortcxix = cxstack_ix;
 

diff --git a/t/op/closure.t b/t/op/closure.t
index 2425a59..f9da311 100755 (executable)
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use Config;
 
-print "1..185\n";
+print "1..186\n";
 
 my $test = 1;
 sub test (&) {
@@ -668,4 +668,16 @@ __EOF__
     END { 1 while unlink $progfile }
 }
 
+{
+    # bugid #24914 = used to coredump restoring PL_comppad in the
+    # savestack, due to the early freeing of the anon closure
+
+    my $got = runperl(stderr => 1, prog => 
+'sub d {die} my $f; $f = sub {my $x=1; $f = 0; d}; eval{$f->()}; print qw(ok)'
+    );
+    test { $got eq 'ok' };
+}
+
+
+