Recursive MULTICALL prematurely freed CV

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.

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);                                  \

diff --git a/ext/XS-APItest/t/multicall.t b/ext/XS-APItest/t/multicall.t
index 4a86047..69f7b77 100644 (file)
--- a/ext/XS-APItest/t/multicall.t
+++ b/ext/XS-APItest/t/multicall.t
@@ -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");
+
+}