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