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