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