#!perl
use lib 't';
use FFI::Raw;
use CompileTest;
my $test = '05-callbacks';
my $source = "./t/$test.c";
my $shared = CompileTest::compile($source);
my $take_one_int_callback = FFI::Raw -> new(
$shared, 'take_one_int_callback',
FFI::Raw::void, FFI::Raw::ptr
);
my $func1 = sub {
my $num = shift;
print ($num == 42 ? "ok\n" : "not ok\n");
};
my $cb1 = FFI::Raw::callback($func1, FFI::Raw::void, FFI::Raw::int);
$take_one_int_callback -> call($cb1);
$take_one_int_callback -> ($cb1);
print "ok - survived the call\n";
my $return_int_callback = FFI::Raw -> new(
$shared, 'return_int_callback',
FFI::Raw::int, FFI::Raw::ptr
);
my $func2 = sub {
my $num = shift;
return $num + 15;
};
my $cb2 = FFI::Raw::callback($func2, FFI::Raw::int, FFI::Raw::int);
my $check1 = $return_int_callback -> call($cb2);
my $check2 = $return_int_callback -> ($cb2);
print "ok - survived the call\n";
print ($check1 == (42 + 15) ? "ok\n" : "not ok - returned $check1\n");
print ($check2 == (42 + 15) ? "ok\n" : "not ok - returned $check2\n");
sub func3 {
my $num = shift;
return $num + 15;
};
my $cb3 = FFI::Raw::callback(\&func3, FFI::Raw::int, FFI::Raw::int);
$check1 = $return_int_callback -> call($cb3);
$check2 = $return_int_callback -> ($cb3);
print "ok - survived the call (anonymous subroutine)\n";
print ($check1 == (42 + 15) ? "ok\n" : "not ok - returned $check1\n");
print ($check2 == (42 + 15) ? "ok\n" : "not ok - returned $check2\n");
my $str_value = "foo";
my $cb4 = FFI::Raw::callback(sub { $str_value }, FFI::Raw::str);
print "ok - survived the call\n";
my $return_str_callback = FFI::Raw -> new(
$shared, 'return_str_callback',
FFI::Raw::void, FFI::Raw::ptr
);
$return_str_callback -> call($cb4);
my $get_str_value = FFI::Raw -> new(
$shared, 'get_str_value',
FFI::Raw::str,
);
my $value = $get_str_value -> call();
print ($value eq 'foo' ? "ok\n" : "not ok - returned $value\n");
$str_value = undef;
$return_str_callback->call($cb4);
my $value = $get_str_value -> call();
print ($value eq 'NULL' ? "ok\n" : "not ok - returned $value\n");
my $reset = FFI::Raw -> new(
$shared, 'reset',
FFI::Raw::void,
);
$reset -> call();
my $buffer = FFI::Raw::MemPtr -> new_from_buf("bar\0", length "bar\0");
my $cb5 = FFI::Raw::callback(sub { $buffer }, FFI::Raw::ptr);
print "ok - survived the call\n";
$return_str_callback -> call($cb5);
$value = $get_str_value -> call();
print ($value eq 'bar' ? "ok\n" : "not ok - returned $value\n");
$reset -> call();
$buffer = FFI::Raw::MemPtr -> new_from_buf("baz\0", length "baz\0");
my $cb6 = FFI::Raw::callback(sub { $$buffer }, FFI::Raw::ptr);
print "ok - survived the call\n";
$return_str_callback -> call($cb6);
$value = $get_str_value -> call();
print ($value eq 'baz' ? "ok\n" : "not ok - returned $value\n");
$reset -> call();
my $cb7 = FFI::Raw::callback(sub { undef }, FFI::Raw::ptr);
print "ok - survived the call\n";
$return_str_callback -> call($cb7);
$value = $get_str_value -> call();
print ($value eq 'NULL' ? "ok\n" : "not ok - returned $value\n");
print "1..18\n";