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 => 7;
  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             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 }