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 7use warnings; 8use strict; 9 10use Test::More tests => 7; 11use 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 no warnings 'void'; 38 $closure_var; 39 my $sub = shift; 40 if (defined $sub) { 41 XS::APItest::multicall_each \&$sub, 1,2,3; 42 } 43 }; 44 bless $f, 'REC'; 45 $f->($f); 46 is($destroyed, 0, "f not yet destroyed"); 47 } 48 is($destroyed, 1, "f now destroyed"); 49 50} 51 52# [perl #115602] 53# deep recursion realloced the CX stack, but the dMULTICALL local var 54# 'cx' still pointed to the old one. 55# Thius doesn;t actually test the failure (I couldn't think of a way to 56# get the failure to show at the perl level) but it allows valgribnd or 57# similar to spot any errors. 58 59{ 60 sub rec { my $c = shift; rec($c-1) if $c > 0 }; 61 my @r = XS::APItest::multicall_each { rec(90) } 1,2,3; 62 pass("recursion"); 63} 64