Recursive MULTICALL prematurely freed CV
authorDavid Mitchell <davem@iabyn.com>
Tue, 19 Oct 2010 22:13:07 +0000 (23:13 +0100)
committerDavid Mitchell <davem@iabyn.com>
Tue, 19 Oct 2010 22:29:25 +0000 (23:29 +0100)
See [perl #78070].

Basically, POPSUB/LEAVESUB had a mechanism to decrement the reference
count of the CV only at CvDEPTH==1; POP_MULTICALL was decrementing it at
all depths.

cop.h
ext/XS-APItest/t/multicall.t

diff --git a/cop.h b/cop.h
index 4791c80..8e77ae2 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -928,8 +928,8 @@ See L<perlcall/Lightweight Callbacks>.
 
 #define POP_MULTICALL \
     STMT_START {                                                       \
-       LEAVESUB(multicall_cv);                                         \
-       CvDEPTH(multicall_cv)--;                                        \
+       if (! --CvDEPTH(multicall_cv))                                  \
+           LEAVESUB(multicall_cv);                                     \
        POPBLOCK(cx,PL_curpm);                                          \
        POPSTACK;                                                       \
        CATCH_SET(multicall_oldcatch);                                  \
index 4a86047..69f7b77 100644 (file)
@@ -7,7 +7,7 @@
 use warnings;
 use strict;
 
-use Test::More tests => 4;
+use Test::More tests => 6;
 use XS::APItest;
 
 
@@ -22,3 +22,28 @@ use XS::APItest;
     is($a[1], 3, "a[1] okay");
     is($a[2], 4, "a[2] okay");
 }
+
+# [perl #78070]
+# multicall using a sub that aleady has CvDEPTH > 1 caused sub
+# to be prematurely freed
+
+{
+    my $destroyed = 0;
+    sub REC::DESTROY { $destroyed = 1 }
+
+    my $closure_var;
+    {
+       my $f = sub {
+           $closure_var;
+           my $sub = shift;
+           if (defined $sub) {
+               XS::APItest::multicall_each \&$sub, 1,2,3;
+           }
+       };
+       bless $f,  'REC';
+       $f->($f);
+       is($destroyed, 0, "f not yet destroyed");
+    }
+    is($destroyed, 1, "f now destroyed");
+
+}