Commit | Line | Data |
---|---|---|
73bf7552 | 1 | #!perl -T |
9e8c31cc | 2 | |
11fd7d05 RGS |
3 | use strict; |
4 | use Config; | |
150e77ce | 5 | |
494364e0 | 6 | my $db_file; |
11fd7d05 | 7 | BEGIN { |
e6ea8c3b | 8 | if (not eval "use Test::More; 1") { |
150e77ce SP |
9 | print "1..0 # Skip: Test::More not available\n"; |
10 | die "Test::More not available\n"; | |
11 | } | |
494364e0 | 12 | |
e6ea8c3b CBW |
13 | plan(skip_all => "these tests needs Perl 5.5+") if $] < 5.005; |
14 | ||
494364e0 JH |
15 | use Config; |
16 | foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) { | |
17 | if ($Config{extensions} =~ /\b$_\b/) { | |
18 | $db_file = $_; | |
19 | last; | |
20 | } | |
21 | } | |
11fd7d05 RGS |
22 | } |
23 | ||
24 | ||
150e77ce SP |
25 | my %modules = ( |
26 | # ModuleName => q|code to check that it was loaded|, | |
27 | 'Cwd' => q| ::can_ok( 'Cwd' => 'fastcwd' ) |, # 5.7 ? | |
960ddb65 FC |
28 | 'File::Glob' => q| ::can_ok( 'File::Glob' => # 5.6 |
29 | $] > 5.014 | |
30 | ? 'bsd_glob' : 'doglob') |, | |
494364e0 | 31 | $db_file => q| ::can_ok( $db_file => 'TIEHASH' ) |, # 5.0 |
150e77ce SP |
32 | 'Socket' => q| ::can_ok( 'Socket' => 'inet_aton' ) |, # 5.0 |
33 | 'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep' ) |, # 5.7.3 | |
34 | ); | |
35 | ||
08e3451d | 36 | plan tests => keys(%modules) * 3 + 10; |
150e77ce SP |
37 | |
38 | # Try to load the module | |
39 | use_ok( 'XSLoader' ); | |
11fd7d05 RGS |
40 | |
41 | # Check functions | |
42 | can_ok( 'XSLoader' => 'load' ); | |
150e77ce | 43 | can_ok( 'XSLoader' => 'bootstrap_inherit' ); |
11fd7d05 RGS |
44 | |
45 | # Check error messages | |
e6ea8c3b CBW |
46 | my @cases = ( |
47 | [ 'Thwack', 'package Thwack; XSLoader::load(); 1' ], | |
48 | [ 'Zlott' , 'package Thwack; XSLoader::load("Zlott"); 1' ], | |
49 | ); | |
50 | ||
51 | for my $case (@cases) { | |
52 | my ($should_load, $codestr) = @$case; | |
53 | my $diag; | |
1d2b7ec5 | 54 | |
e6ea8c3b | 55 | # determine the expected diagnostic |
1d2b7ec5 | 56 | if ($Config{usedl}) { |
e6ea8c3b CBW |
57 | if ($case->[0] eq "Thwack" and ($] == 5.008004 or $] == 5.008005)) { |
58 | # these versions had bugs with chained C<goto &> | |
59 | $diag = "Usage: DynaLoader::bootstrap\\(module\\)"; | |
60 | } else { | |
61 | # normal diagnostic for a perl with dynamic loading | |
62 | $diag = "Can't locate loadable object for module $should_load in \@INC"; | |
63 | } | |
64 | } else { | |
65 | # a perl with no dynamic loading | |
66 | $diag = "Can't load module $should_load, dynamic loading not available in this perl."; | |
1d2b7ec5 | 67 | } |
e6ea8c3b CBW |
68 | |
69 | is(eval $codestr, undef, "eval '$codestr' should die"); | |
70 | like($@, qr/^$diag/, "calling XSLoader::load() under a package with no XS part"); | |
99df65aa | 71 | } |
150e77ce | 72 | |
11fd7d05 RGS |
73 | # Now try to load well known XS modules |
74 | my $extensions = $Config{'extensions'}; | |
75 | $extensions =~ s|/|::|g; | |
9e8c31cc | 76 | |
11fd7d05 RGS |
77 | for my $module (sort keys %modules) { |
78 | SKIP: { | |
e6ea8c3b | 79 | skip "$module not available", 3 if $extensions !~ /\b$module\b/; |
150e77ce | 80 | |
91152fc1 | 81 | eval qq{ package $module; XSLoader::load('$module', "12345678"); }; |
e6ea8c3b | 82 | like( $@, "/^$module object version \\S+ does not match bootstrap parameter 12345678/", |
150e77ce SP |
83 | "calling XSLoader::load() with a XS module and an incorrect version" ); |
84 | ||
85 | eval qq{ package $module; XSLoader::load('$module'); }; | |
11fd7d05 | 86 | is( $@, '', "XSLoader::load($module)"); |
150e77ce SP |
87 | |
88 | eval qq{ package $module; $modules{$module}; }; | |
11fd7d05 RGS |
89 | } |
90 | } | |
9e8c31cc | 91 | |
d31021d2 FC |
92 | SKIP: { |
93 | skip "Needs 5.15.6", 1 unless $] > 5.0150051; | |
94 | skip "List::Util not available", 1 if $extensions !~ /\bList::Util\b/; | |
95 | eval 'package List::Util; XSLoader::load(__PACKAGE__, "version")'; | |
96 | like $@, "/^Invalid version format/", | |
97 | 'correct error msg for invalid versions'; | |
98 | } | |
8e6aa27c TC |
99 | |
100 | SKIP: { | |
101 | skip "Devel::Peek not available", 1 | |
102 | unless $extensions =~ /\bDevel::Peek\b/; | |
103 | ||
104 | # XSLoader::load() assumes it's being called from a module, so | |
71390552 CB |
105 | # pretend it is, first find where Devel/Peek.pm is |
106 | my $peek_file = "Devel/Peek.pm"; | |
8e6aa27c TC |
107 | my $module_path; |
108 | for my $dir (@INC) { | |
71390552 CB |
109 | if (-f "$dir/$peek_file") { |
110 | $module_path = "$dir/Not/Devel/Peek.pm"; | |
8e6aa27c TC |
111 | last; |
112 | } | |
113 | } | |
114 | ||
71390552 | 115 | skip "Cannot find $peek_file", 1 |
8e6aa27c TC |
116 | unless $module_path; |
117 | ||
118 | # [perl #122455] | |
8e6aa27c TC |
119 | # die instead of falling back to DynaLoader |
120 | local *XSLoader::bootstrap_inherit = sub { die "Fallback to DynaLoader\n" }; | |
121 | ::ok( eval <<EOS, "test correct path searched for modules") | |
122 | package Not::Devel::Peek; | |
123 | #line 1 "$module_path" | |
124 | XSLoader::load("Devel::Peek"); | |
125 | EOS | |
126 | or ::diag $@; | |
127 | } | |
08e3451d FC |
128 | |
129 | SKIP: { | |
130 | skip "File::Path not available", 1 | |
131 | unless eval { require File::Path }; | |
132 | my $name = "phooo$$"; | |
ae635bbf | 133 | File::Path::mkpath("$name/auto/Foo/Bar"); |
08e3451d FC |
134 | open my $fh, |
135 | ">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}"; | |
136 | close $fh; | |
137 | my $fell_back; | |
138 | local *XSLoader::bootstrap_inherit = sub { | |
139 | $fell_back++; | |
140 | # Break out of the calling subs | |
141 | goto the_test; | |
142 | }; | |
143 | eval <<END; | |
144 | #line 1 $name | |
145 | package Foo::Bar; | |
146 | XSLoader::load("Foo::Bar"); | |
147 | END | |
148 | the_test: | |
149 | ok $fell_back, | |
150 | 'XSLoader will not load relative paths based on (caller)[1]'; | |
ae635bbf | 151 | File::Path::rmtree($name); |
08e3451d | 152 | } |