1use Test2::V0 -no_srand => 1;
2use FFI::Platypus::Closure;
3use FFI::CheckLib;
4
5my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
6
7subtest 'basic' => sub {
8  my $ffi = FFI::Platypus->new;
9
10  my $closure = $ffi->closure(sub { $_[0] + 1});
11  isa_ok $closure, 'FFI::Platypus::Closure';
12  is $closure->(1), 2, 'closure.(1) = 2';
13
14  my $c = sub { $_[0] + 2 };
15  $closure = $ffi->closure($c);
16  isa_ok $closure, 'FFI::Platypus::Closure';
17  is $closure->(1), 3, 'closure.(1) = 3';
18  is $closure->call(1), 3, 'closure.call(1) = 3';
19
20  $closure = $ffi->closure($c);
21  isa_ok $closure, 'FFI::Platypus::Closure';
22  is $closure->(1), 3, 'closure.(1) = 3';
23  is $closure->call(1), 3, 'closure.call(1) = 3';
24};
25
26subtest 'sticky' => sub {
27  my $closure = FFI::Platypus::Closure->new(sub { 'foo' });
28  isa_ok $closure, 'FFI::Platypus::Closure';
29
30  my $refcnt = $closure->_svrefcnt;
31  note "_svrefcnt = $refcnt";
32
33  eval { $closure->sticky };
34  is $@, '', 'called $closure->sticky';
35
36  is($closure->_svrefcnt, $refcnt+2);
37
38  eval { $closure->sticky };
39  is $@, '', 'called $closure->sticky';
40
41  is($closure->_svrefcnt, $refcnt+2);
42
43  eval { $closure->unstick };
44  is $@, '', 'called $closure->unstick';
45
46  is($closure->_svrefcnt, $refcnt);
47};
48
49subtest 'private' => sub {
50  my $closure = FFI::Platypus::Closure->new(sub { $_[0] + 1});
51  isa_ok $closure, 'FFI::Platypus::Closure';
52  is $closure->(1), 2, 'closure.(1) = 2';
53};
54
55subtest 'space' => sub {
56  my $ffi = FFI::Platypus->new;
57
58  eval { $ffi->type('(int,int)->void') };
59  is $@, '', 'good without space';
60
61  eval { $ffi->type('(int, int) -> void') };
62  is $@, '', 'good with space';
63};
64
65subtest 'die' => sub {
66  my $ffi = FFI::Platypus->new;
67  $ffi->lib($libtest);
68
69  my $closure = $ffi->closure(sub {
70    die "omg i don't want to die!";
71  });
72
73  my $set_closure = $ffi->function(pointer_set_closure => ['(opaque)->opaque'] => 'void');
74  my $call_closure = $ffi->function(pointer_call_closure => ['opaque'] => 'opaque');
75
76  $set_closure->($closure);
77
78  my $warning;
79  do {
80    local $SIG{__WARN__} = sub { $warning = $_[0] };
81    $call_closure->(undef);
82  };
83
84  like $warning, qr{omg i don't want to die};
85  pass 'does not exit';
86  note "warning = '$warning'";
87};
88
89subtest 'reuse' => sub {
90  my $ffi = FFI::Platypus->new;
91  $ffi->lib($libtest);
92
93  my $closure = $ffi->closure(sub {
94    if (@_) {
95      return $_[0] * 7;
96    }
97    return 21;
98  });
99
100  my $set_closure1 = $ffi->function( closure_set_closure1 => ['()->int'] => 'void');
101  my $set_closure2 = $ffi->function( closure_set_closure2 => ['(int)->int'] => 'void');
102  my $call_closure1 = $ffi->function( closure_call_closure1 => [] => 'int');
103  my $call_closure2 = $ffi->function( closure_call_closure2 => ['int'] => 'int');
104
105  $set_closure1->($closure);
106  $set_closure2->($closure);
107
108  is $call_closure1->(), 21;
109  is $call_closure2->(42), 294;
110};
111
112subtest 'immediate' => sub {
113  my $ffi = FFI::Platypus->new;
114  $ffi->lib($libtest);
115
116  my $ret = $ffi->function( closure_call_closure_immediate => ['()->int'] => 'int')->call(
117    $ffi->closure(sub { return 42; })
118  );
119
120  is $ret, 42;
121};
122
123subtest 'closure passing into a closure' => sub {
124
125  my $ffi = FFI::Platypus->new;
126  eval { $ffi->type('((int)->int)->int') };
127  isnt "$@", "";
128  note "error = $@";
129
130  $ffi->type('(int)->int' => 'foo_t');
131  eval { $ffi->type('()->foo_t') };
132  isnt "$@", "";
133  note "error = $@";
134
135};
136
137done_testing;
138