1use Test2::V0 -no_srand => 1;
2use lib 't/lib';
3use Test::Cleanup;
4use FFI::Platypus;
5use FFI::Temp;
6use FFI::Build;
7use File::Basename qw( dirname );
8use File::Path qw( mkpath );
9use File::Spec;
10use Capture::Tiny qw( capture_merged );
11
12subtest 'from installed' => sub {
13
14  local @INC = @INC;
15
16  my $root = FFI::Temp->newdir;
17
18  spew("$root/lib/Foo/Bar1.pm", <<'EOF');
19    package Foo::Bar1;
20    use strict;
21    use warnings;
22    use FFI::Platypus;
23    my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
24    $ffi->bundle;
25    $ffi->attach("bar1" => [] => 'sint32');
26    1;
27EOF
28
29  my $build = FFI::Build->new(
30    'bar1',
31    source => [ [ C => \"int bar1(void) { return 42; }\n" ]],
32    verbose => 2,
33    dir => "$root/lib/auto/share/dist/Foo-Bar1",
34    export => ["bar1"],
35  );
36
37  my($build_out,$lib) = capture_merged {
38    $build->build;
39  };
40  note $build_out;
41
42  spew("$root/lib/auto/Foo/Bar1/Bar1.txt",
43       'FFI::Build@' . File::Spec->abs2rel("$lib", "$root/lib"));
44
45  ok( !  FFI::Platypus->can('_bundle') );
46
47  unshift @INC, "$root/lib";
48  local $@ = '';
49  eval " require Foo::Bar1; ";
50  is "$@", '';
51  is( Foo::Bar1::bar1(), 42 );
52
53  ok( !! FFI::Platypus->can('_bundle') );
54
55  cleanup(
56    sub { $build->clean },
57    $root,
58  );
59
60};
61
62subtest 'from blib' => sub {
63
64  local @INC = @INC;
65
66  my $root = FFI::Temp->newdir;
67
68  spew("$root/lib/Foo/Bar2.pm", <<'EOF');
69    package Foo::Bar2;
70    use strict;
71    use warnings;
72    use FFI::Platypus;
73    my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
74    $ffi->bundle;
75    $ffi->attach("bar2" => [] => 'sint32');
76    1;
77EOF
78
79  my $build = FFI::Build->new(
80    'bar2',
81    source => [ [ C => \"int bar2(void) { return 43; }\n" ]],
82    verbose => 2,
83    dir => "$root/lib/auto/share/dist/Foo-Bar2",
84    export => ['bar2'],
85  );
86
87  my($build_out,$lib) = capture_merged {
88    $build->build;
89  };
90  note $build_out;
91
92  spew("$root/arch/auto/Foo/Bar2/Bar2.txt",
93       'FFI::Build@' . File::Spec->abs2rel("$lib", "$root/lib"));
94
95  unshift @INC, "$root/lib";
96  local $@ = '';
97  eval " require Foo::Bar2; ";
98  is "$@", '';
99  is( Foo::Bar2::bar2(), 43 );
100
101  cleanup(
102    sub { $build->clean },
103    $root,
104  );
105};
106
107subtest 'not loaded yet' => sub {
108
109  local @INC = @INC;
110
111  my $root = FFI::Temp->newdir;
112
113  spew("$root/lib/Foo/Bar3.pm", <<'EOF');
114    package Foo::Bar3;
115    die;
116    1;
117EOF
118
119  my $build = FFI::Build->new(
120    'bar3',
121    source => [ [ C => \"int bar3(void) { return 44; }\n" ]],
122    verbose => 2,
123    dir => "$root/lib/auto/share/dist/Foo-Bar3",
124    export => ['bar3'],
125  );
126
127  my($build_out,$lib) = capture_merged {
128    $build->build;
129  };
130  note $build_out;
131
132  spew("$root/lib/auto/Foo/Bar3/Bar3.txt",
133       'FFI::Build@' . File::Spec->abs2rel("$lib", "$root/lib"));
134
135  unshift @INC, "$root/lib";
136
137  my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
138  $ffi->bundle('Foo::Bar3');
139  $ffi->attach("bar3" => [] => 'sint32');
140  is( bar3(), 44 );
141
142  cleanup(
143    sub { $build->clean },
144    $root,
145  );
146
147};
148
149subtest 'with a ffi dir' => sub {
150
151  local @INC = @INC;
152
153  my $root = FFI::Temp->newdir;
154  cleanup($root);
155
156  spew("$root/lib/Foo/Bar4.pm", <<'EOF');
157    package Foo::Bar4;
158    use strict;
159    use warnings;
160    use FFI::Platypus;
161    my $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
162    $ffi->bundle;
163    $ffi->attach("bar4" => [] => 'sint32');
164    1;
165EOF
166
167  spew("$root/ffi/foo.c", "int bar4(void) { return 45; }" );
168  spew("$root/ffi/foo.fbx", <<'EOF');
169use strict;
170use warnings;
171our $DIR;
172{ export => ['bar4'], source => ["$DIR/*.c"] };
173EOF
174
175  unshift @INC, "$root/lib";
176
177  eval " require Foo::Bar4; ";
178  is "$@", '';
179  is( Foo::Bar4::bar4(), 45 );
180
181};
182
183subtest 'entry points' => sub {
184
185  my $root = FFI::Temp->newdir;
186  cleanup($root);
187
188  our @log;
189  our $log_closure = do {
190    my $ffi = FFI::Platypus->new;
191    $ffi->closure(sub {
192      my($str) = @_;
193      push @log, $str;
194    });
195  };
196
197  spew("$root/lib/Foo/Bar5.pm", <<'EOF');
198    package Foo::Bar5;
199    use strict;
200    use warnings;
201    use FFI::Platypus;
202    our $ffi = FFI::Platypus->new( api => 1, lang => 'ASM' );
203    $ffi->bundle([$ffi->cast('(string)->void' => 'opaque', $main::log_closure)]);
204    1;
205EOF
206
207  spew("$root/ffi/foo.c", <<'EOF');
208#include <ffi_platypus_bundle.h>
209#include <stdio.h>
210
211typedef void (*log_t)(const char *);
212log_t logit;
213char buffer[1024];
214
215void
216ffi_pl_bundle_init(const char *package, int c, void **args)
217{
218  int i;
219  logit = (log_t) args[0];
220  logit("ffi_pl_bundle_init (enter)");
221  sprintf(buffer, "package = %s", package);
222  logit(buffer);
223  sprintf(buffer, "c = %d", c);
224  logit(buffer);
225  for(i=0; args[i] != NULL; i++)
226  {
227    sprintf(buffer, "args[%d] = %d", i, args[i]);
228    logit(buffer);
229  }
230  logit("ffi_pl_bundle_init (leave)");
231}
232
233void
234ffi_pl_bundle_fini(const char *package)
235{
236  logit("ffi_pl_bundle_fini (enter)");
237  sprintf(buffer, "package = %s", package);
238  logit(buffer);
239  logit("ffi_pl_bundle_fini (leave)");
240}
241
242EOF
243
244  spew("$root/ffi/foo.fbx", <<'EOF');
245use strict;
246use warnings;
247our $DIR;
248{ export => ['ffi_pl_bundle_init','ffi_pl_bundle_fini'], source => ["$DIR/*.c"] };
249EOF
250
251  unshift @INC, "$root/lib";
252
253  local $@ = '';
254  eval " require Foo::Bar5; ";
255  is "$@", '';
256
257  note "log:$_" for @log;
258
259  is(scalar(@log), 5);
260  is($log[0], 'ffi_pl_bundle_init (enter)');
261  is($log[1], 'package = Foo::Bar5');
262  is($log[2], 'c = 1');
263  like($log[3], qr/^args\[0\] = -?[0-9]+$/);
264  is($log[4], 'ffi_pl_bundle_init (leave)');
265
266  @log = ();
267
268  ok 1;
269
270  {
271    no warnings 'once';
272    undef $Foo::Bar5::ffi;
273  }
274
275  note "log:$_" for @log;
276
277  is(
278    \@log,
279    [
280      'ffi_pl_bundle_fini (enter)',
281      'package = Foo::Bar5',
282      'ffi_pl_bundle_fini (leave)',
283    ],
284  );
285
286  @log = ();
287
288};
289
290done_testing;
291
292sub spew
293{
294  my($fn, $content) = @_;
295
296  note "spew(start)[$fn]\n";
297  note $content;
298  note "spew(end)\n";
299
300  my $dir = dirname $fn;
301  mkpath $dir, 0, oct(755) unless -d $dir;
302  open my $fh, '>', $fn;
303  print $fh $content;
304  close $fh;
305}
306