Commit | Line | Data |
28892255 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use Test::More; |
5 | use Config; |
6 | use DynaLoader; |
7 | use ExtUtils::CBuilder; |
8 | use attributes; |
9 | use overload; |
10 | |
387b6f8d |
11 | plan tests => 25; |
28892255 |
12 | |
13 | my ($source_file, $obj_file, $lib_file); |
14 | |
15 | require_ok( 'ExtUtils::ParseXS' ); |
16 | ExtUtils::ParseXS->import('process_file'); |
17 | |
18 | chdir 't' or die "Can't chdir to t/, $!"; |
19 | |
20 | use Carp; $SIG{__WARN__} = \&Carp::cluck; |
21 | |
22 | ######################### |
23 | |
24 | $source_file = 'XSMore.c'; |
25 | |
26 | # Try sending to file |
27 | ExtUtils::ParseXS->process_file( |
28 | filename => 'XSMore.xs', |
29 | output => $source_file, |
30 | ); |
31 | ok -e $source_file, "Create an output file"; |
32 | |
33 | my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE}; |
34 | my $b = ExtUtils::CBuilder->new(quiet => $quiet); |
35 | |
36 | SKIP: { |
37 | skip "no compiler available", 2 |
38 | if ! $b->have_compiler; |
39 | $obj_file = $b->compile( source => $source_file ); |
40 | ok $obj_file; |
41 | ok -e $obj_file, "Make sure $obj_file exists"; |
42 | } |
43 | |
44 | SKIP: { |
387b6f8d |
45 | skip "no dynamic loading", 6 |
28892255 |
46 | if !$b->have_compiler || !$Config{usedl}; |
47 | my $module = 'XSMore'; |
48 | $lib_file = $b->link( objects => $obj_file, module_name => $module ); |
49 | ok $lib_file; |
50 | ok -e $lib_file, "Make sure $lib_file exists"; |
51 | |
52 | eval{ |
53 | package XSMore; |
54 | our $VERSION = 42; |
55 | our $boot_ok; |
56 | DynaLoader::bootstrap_inherit(__PACKAGE__, $VERSION); # VERSIONCHECK disabled |
57 | |
58 | sub new{ bless {}, shift } |
59 | }; |
60 | is $@, ''; |
61 | is ExtUtils::ParseXS::errors(), 0, 'ExtUtils::ParseXS::errors()'; |
62 | |
63 | is $XSMore::boot_ok, 100, 'the BOOT keyword'; |
64 | |
65 | ok XSMore::include_ok(), 'the INCLUDE keyword'; |
66 | is prototype(\&XSMore::include_ok), "", 'the PROTOTYPES keyword'; |
67 | |
68 | is prototype(\&XSMore::prototype_ssa), '$$@', 'the PROTOTYPE keyword'; |
69 | |
70 | is_deeply [attributes::get(\&XSMore::attr_method)], [qw(method)], 'the ATTRS keyword'; |
71 | is prototype(\&XSMore::attr_method), '$;@', 'ATTRS with prototype'; |
72 | |
73 | is XSMore::return_1(), 1, 'the CASE keyword (1)'; |
74 | is XSMore::return_2(), 2, 'the CASE keyword (2)'; |
75 | is prototype(\&XSMore::return_1), "", 'ALIAS with prototype (1)'; |
76 | is prototype(\&XSMore::return_2), "", 'ALIAS with prototype (2)'; |
77 | |
78 | is XSMore::arg_init(200), 200, 'argument init'; |
79 | |
80 | ok overload::Overloaded(XSMore->new), 'the FALLBACK keyword'; |
81 | is abs(XSMore->new), 42, 'the OVERLOAD keyword'; |
82 | |
83 | my @a; |
84 | XSMore::hook(\@a); |
85 | is_deeply \@a, [qw(INIT CODE POSTCALL CLEANUP)], 'the INIT & POSTCALL & CLEANUP keywords'; |
86 | |
87 | is_deeply [XSMore::outlist()], [ord('a'), ord('b')], 'the OUTLIST keyword'; |
88 | |
89 | is XSMore::len("foo"), 3, 'the length keyword'; |
90 | |
387b6f8d |
91 | is XSMore::sum(5, 9), 14, 'the INCLUDE_COMMAND directive'; |
92 | |
28892255 |
93 | # Win32 needs to close the DLL before it can unlink it, but unfortunately |
94 | # dl_unload_file was missing on Win32 prior to perl change #24679! |
95 | if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) { |
96 | for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) { |
97 | if ($DynaLoader::dl_modules[$i] eq $module) { |
98 | DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]); |
99 | last; |
100 | } |
101 | } |
102 | } |
103 | } |
104 | |
105 | unless ($ENV{PERL_NO_CLEANUP}) { |
106 | for ( $obj_file, $lib_file, $source_file) { |
107 | next unless defined $_; |
108 | 1 while unlink $_; |
109 | } |
110 | } |