Commit | Line | Data |
708f9ca6 |
1 | #!/usr/bin/perl |
2 | |
708f9ca6 |
3 | use strict; |
6986f47f |
4 | use Test::More; |
5 | use Config; |
708f9ca6 |
6 | use DynaLoader; |
708f9ca6 |
7 | use ExtUtils::CBuilder; |
6986f47f |
8 | |
9 | if ( $] < 5.008 ) { |
10 | plan skip_all => "INTERFACE keyword support broken before 5.8"; |
11 | } |
12 | else { |
13 | plan tests => 24; |
14 | } |
15 | |
16 | my ($source_file, $obj_file, $lib_file, $module); |
17 | |
18 | require_ok( 'ExtUtils::ParseXS' ); |
19 | ExtUtils::ParseXS->import('process_file'); |
708f9ca6 |
20 | |
21 | chdir 't' or die "Can't chdir to t/, $!"; |
22 | |
23 | use Carp; $SIG{__WARN__} = \&Carp::cluck; |
24 | |
25 | ######################### |
26 | |
6986f47f |
27 | $source_file = 'XSUsage.c'; |
708f9ca6 |
28 | |
29 | # Try sending to file |
30 | process_file(filename => 'XSUsage.xs', output => $source_file); |
6986f47f |
31 | ok -e $source_file, "Create an output file"; |
708f9ca6 |
32 | |
33 | # TEST doesn't like extraneous output |
34 | my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE}; |
35 | |
36 | # Try to compile the file! Don't get too fancy, though. |
37 | my $b = ExtUtils::CBuilder->new(quiet => $quiet); |
708f9ca6 |
38 | |
6986f47f |
39 | SKIP: { |
40 | skip "no compiler available", 2 |
41 | if ! $b->have_compiler; |
42 | $module = 'XSUsage'; |
43 | |
44 | $obj_file = $b->compile( source => $source_file ); |
708f9ca6 |
45 | ok $obj_file; |
6986f47f |
46 | ok -e $obj_file, "Make sure $obj_file exists"; |
47 | } |
48 | SKIP: { |
49 | skip "no dynamic loading", 20 |
50 | if !$b->have_compiler || !$Config{usedl}; |
708f9ca6 |
51 | |
6986f47f |
52 | $lib_file = $b->link( objects => $obj_file, module_name => $module ); |
708f9ca6 |
53 | ok $lib_file; |
6986f47f |
54 | ok -e $lib_file, "Make sure $lib_file exists"; |
708f9ca6 |
55 | |
56 | eval {require XSUsage}; |
6986f47f |
57 | is $@, ''; |
708f9ca6 |
58 | |
59 | # The real tests here - for each way of calling the functions, call with the |
60 | # wrong number of arguments and check the Usage line is what we expect |
61 | |
62 | eval { XSUsage::one(1) }; |
63 | ok $@; |
64 | ok $@ =~ /^Usage: XSUsage::one/; |
65 | |
66 | eval { XSUsage::two(1) }; |
67 | ok $@; |
68 | ok $@ =~ /^Usage: XSUsage::two/; |
69 | |
70 | eval { XSUsage::two_x(1) }; |
71 | ok $@; |
72 | ok $@ =~ /^Usage: XSUsage::two_x/; |
73 | |
74 | eval { FOO::two(1) }; |
75 | ok $@; |
76 | ok $@ =~ /^Usage: FOO::two/; |
77 | |
78 | eval { XSUsage::three(1) }; |
79 | ok $@; |
80 | ok $@ =~ /^Usage: XSUsage::three/; |
81 | |
82 | eval { XSUsage::four(1) }; |
83 | ok !$@; |
84 | |
85 | eval { XSUsage::five() }; |
86 | ok $@; |
87 | ok $@ =~ /^Usage: XSUsage::five/; |
88 | |
89 | eval { XSUsage::six() }; |
90 | ok !$@; |
91 | |
92 | eval { XSUsage::six(1) }; |
93 | ok !$@; |
94 | |
95 | eval { XSUsage::six(1,2) }; |
96 | ok $@; |
97 | ok $@ =~ /^Usage: XSUsage::six/; |
98 | |
99 | # Win32 needs to close the DLL before it can unlink it, but unfortunately |
100 | # dl_unload_file was missing on Win32 prior to perl change #24679! |
101 | if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) { |
102 | for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) { |
103 | if ($DynaLoader::dl_modules[$i] eq $module) { |
104 | DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]); |
105 | last; |
106 | } |
107 | } |
108 | } |
708f9ca6 |
109 | } |
110 | |
6986f47f |
111 | unless ($ENV{PERL_NO_CLEANUP}) { |
112 | for ( $obj_file, $lib_file, $source_file) { |
113 | next unless defined $_; |
114 | 1 while unlink $_; |
115 | } |
116 | } |
117 | |