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