1use Test2::V0 -no_srand => 1;
2use FFI::Platypus::Function;
3use FFI::Platypus;
4use FFI::CheckLib;
5use FFI::Platypus::TypeParser::Version0;
6
7my $libtest = find_lib lib => 'test', symbol => 'f0', libpath => 't/ffi';
8
9subtest 'built in type' => sub {
10  my $ffi = FFI::Platypus->new;
11  $ffi->lib($libtest);
12  my $function = eval { $ffi->function('f0', [ 'uint8' ] => 'uint8') };
13  is $@, '', 'ffi.function(f0, [uint8] => uint8)';
14  isa_ok $function, 'FFI::Platypus::Function';
15  isa_ok $function, 'FFI::Platypus::Function::Function';
16  is $function->call(22), 22, 'function.call(22) = 22';
17  is $function->(22), 22, 'function.(22) = 22';
18};
19
20subtest 'custom type' => sub {
21  my $ffi = FFI::Platypus->new;
22  $ffi->lib($libtest);
23  $ffi->type('uint8' => 'my_int_8');
24  my $function = eval { $ffi->function('f0', [ 'my_int_8' ] => 'my_int_8') };
25  is $@, '', 'ffi.function(f0, [my_int_8] => my_int_8)';
26  isa_ok $function, 'FFI::Platypus::Function';
27  isa_ok $function, 'FFI::Platypus::Function::Function';
28  is $function->call(22), 22, 'function.call(22) = 22';
29  is $function->(22), 22, 'function.(22) = 22';
30};
31
32subtest 'private' => sub {
33  my $ffi = FFI::Platypus->new;
34  $ffi->lib($libtest);
35
36  my $address = $ffi->find_symbol('f0');
37  my $uint8   = FFI::Platypus::TypeParser::Version0->new->parse('uint8');
38
39  my $function = eval { FFI::Platypus::Function::Function->new($ffi, $address, -1, -1, $uint8, $uint8) };
40  is $@, '', 'FFI::Platypus::Function->new';
41  isa_ok $function, 'FFI::Platypus::Function';
42  isa_ok $function, 'FFI::Platypus::Function::Function';
43
44  is $function->call(22), 22, 'function.call(22) = 22';
45
46  $function->attach('main::fooble', 'whatever.c', undef);
47
48  is fooble(22), 22, 'fooble(22) = 22';
49
50};
51
52subtest 'meta' => sub {
53  my $ffi = FFI::Platypus->new;
54  $ffi->lib($libtest);
55
56  $ffi->attach(mymeta_new    => [ 'int', 'string' ] => 'opaque');
57  $ffi->attach(mymeta_delete => [ 'opaque' ] => 'void' );
58
59  subtest 'unattached' => sub {
60
61    my $meta = mymeta_new(4, "prime");
62
63    my $f = $ffi->_function_meta('mymeta_test' => $meta => [ 'string' ] => 'string' );
64
65    is($f->call(), "foo = 4, bar = prime, baz = undef, count = 0");
66    is($f->call("just one"), "foo = 4, bar = prime, baz = just one, count = 1");
67
68    mymeta_delete($meta);
69
70  };
71
72  subtest 'attached' => sub {
73
74    my $meta = mymeta_new(6, "magnus");
75
76    $ffi->_function_meta('mymeta_test' => $meta => [ 'string' ] => 'string' )->attach('mymeta_test1');
77
78    is(mymeta_test1(), "foo = 6, bar = magnus, baz = undef, count = 0");
79    is(mymeta_test1("stella"), "foo = 6, bar = magnus, baz = stella, count = 1");
80  };
81
82};
83
84subtest 'sub_ref' => sub {
85
86  my $ffi = FFI::Platypus->new;
87  $ffi->lib($libtest);
88  my $sub_ref = $ffi->function('f0', [ 'uint8' ] => 'uint8')->sub_ref;
89
90  is $sub_ref->(99), 99, 'calls okay';
91  is ref($sub_ref), 'CODE', 'it is a code reference';
92
93  if(eval { require Sub::Identify; 1 })
94  {
95    my $name = Sub::Identify::sub_name($sub_ref);
96    my $package = Sub::Identify::stash_name($sub_ref);
97    note "name = ${package}::$name";
98  }
99
100};
101
102subtest 'prototype' => sub {
103
104  subtest one => sub {
105
106    my $ffi = FFI::Platypus->new;
107    $ffi->lib($libtest);
108    my $sub_ref = $ffi->attach(['f0' => 'f0_prototyped1'], [ 'uint8' ] => 'uint8', '$');
109
110    is(f0_prototyped1(2), 2); # just make sure it attached okay
111    is(prototype(\&f0_prototyped1), '$');
112
113  };
114
115  subtest two => sub {
116
117    my $ffi = FFI::Platypus->new;
118    $ffi->lib($libtest);
119    my $sub_ref = $ffi->function('f0', [ 'uint8' ] => 'uint8')->attach('f0_prototyped2', '$');
120
121    is(f0_prototyped2(2), 2); # just make sure it attached okay
122    is(prototype(\&f0_prototyped2), '$');
123
124  };
125
126};
127
128subtest 'variadic' => sub {
129
130  my $ffi = FFI::Platypus->new;
131  $ffi->lib($libtest);
132
133  skip_all 'test requires variadic function support'
134    unless eval { $ffi->function('variadic_return_arg' => ['int'] => ['int'] => 'int') };
135
136
137  my $wrapper = sub {
138    my($xsub, @args) = @_;
139    my $ret = $xsub->(@args);
140    $ret*2;
141  };
142
143  subtest 'unattached' => sub {
144
145    foreach my $i (1..7)
146    {
147      is(
148        $ffi->function(variadic_return_arg => ['int'] => ['int','int','int','int','int','int','int'] => 'int')->call($i,10,20,30,40,50,60,70),
149        $i*10,
150        'sans wrapper'
151      );
152
153      is(
154        $ffi->function(variadic_return_arg => ['int'] => ['int','int','int','int','int','int','int'] => 'int', $wrapper)->call($i,10,20,30,40,50,60,70),
155        $i*10*2,
156        'with wrapper'
157      );
158    }
159  };
160
161  subtest 'attached' => sub {
162
163    $ffi->attach([variadic_return_arg => 'y1'] => ['int'] => ['int','int','int','int','int','int','int'] => 'int');
164    $ffi->attach([variadic_return_arg => 'y2'] => ['int'] => ['int','int','int','int','int','int','int'] => 'int', $wrapper);
165
166    foreach my $i (1..7)
167    {
168      is(y1($i,10,20,30,40,50,60,70), $i*10, 'sans wrapper');
169      is(y2($i,10,20,30,40,50,60,70), $i*10*2, 'with wrapper');
170    }
171
172  };
173
174  subtest 'examples' => sub {
175
176    is(
177      $ffi->function( xprintf => ['string'] => ['int'] => 'string' )->call("print integer %d\n", 42),
178      "print integer 42\n",
179    );
180
181    is(
182      $ffi->function( xprintf => ['string'] => ['string'] => 'string' )->call("print string %s\n", 'platypus'),
183      "print string platypus\n",
184    );
185
186    is(
187      $ffi->function( xprintf => ['string'] => ['int','string'] => 'string' )->call("print integer %d and string %s\n", 42, 'platypus'),
188      "print integer 42 and string platypus\n",
189    );
190
191  };
192
193};
194
195subtest 'void as arg should fail is arg count > 1' => sub {
196
197  my $ffi = FFI::Platypus->new;
198
199  eval { $ffi->function( 0 => ['int','void'] => 'void' ) };
200  like "$@", qr/^void not allowed as argument type/;
201
202};
203
204subtest 'single void arg treated as no args' => sub {
205
206  my $ffi = FFI::Platypus->new;
207
208  eval { $ffi->function( 0 => ['void'] => 'void' ) };
209  is "$@", "";
210
211};
212
213done_testing;
214