This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Recursive MULTICALL prematurely freed CV
[perl5.git] / ext / XS-APItest / t / multicall.t
1 #!perl -w
2
3 # test the MULTICALL macros
4 # Note: as of Oct 2010, there are not yet comprehensive tests
5 # for these macros.
6
7 use warnings;
8 use strict;
9
10 use Test::More tests => 6;
11 use XS::APItest;
12
13
14 {
15     my $sum = 0;
16     sub add { $sum += $_++ }
17
18     my @a = (1..3);
19     XS::APItest::multicall_each \&add, @a;
20     is($sum, 6, "sum okay");
21     is($a[0], 2, "a[0] okay");
22     is($a[1], 3, "a[1] okay");
23     is($a[2], 4, "a[2] okay");
24 }
25
26 # [perl #78070]
27 # multicall using a sub that aleady has CvDEPTH > 1 caused sub
28 # to be prematurely freed
29
30 {
31     my $destroyed = 0;
32     sub REC::DESTROY { $destroyed = 1 }
33
34     my $closure_var;
35     {
36         my $f = sub {
37             $closure_var;
38             my $sub = shift;
39             if (defined $sub) {
40                 XS::APItest::multicall_each \&$sub, 1,2,3;
41             }
42         };
43         bless $f,  'REC';
44         $f->($f);
45         is($destroyed, 0, "f not yet destroyed");
46     }
47     is($destroyed, 1, "f now destroyed");
48
49 }