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
|
#!perl -T
use strict;
use Config;
my $db_file;
BEGIN {
eval "use Test::More";
if ($@) {
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' => 'doglob' ) |, # 5.6
$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) * 4 + 5;
# Try to load the module
use_ok( 'XSLoader' );
# Check functions
can_ok( 'XSLoader' => 'load' );
can_ok( 'XSLoader' => 'bootstrap_inherit' );
# Check error messages
eval { XSLoader::load() };
like( $@, '/^XSLoader::load\(\'Your::Module\', \$Your::Module::VERSION\)/',
"calling XSLoader::load() with no argument" );
eval q{ package Thwack; XSLoader::load('Thwack'); };
if ($Config{usedl}) {
like( $@, q{/^Can't locate loadable object for module Thwack in @INC/},
"calling XSLoader::load() under a package with no XS part" );
}
else {
like( $@, q{/^Can't load module Thwack, dynamic loading not available in this perl./},
"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) {
my $warnings = "";
local $SIG{__WARN__} = sub { $warnings = $_[0] };
SKIP: {
skip "$module not available", 4 if $extensions !~ /\b$module\b/;
eval qq{ package $module; XSLoader::load('$module', "qunckkk"); };
like( $@, "/^$module object version \\S+ does not match bootstrap parameter (?:qunckkk|0)/",
"calling XSLoader::load() with a XS module and an incorrect version" );
like( $warnings, "/^\$|^Version string 'qunckkk' contains invalid data; ignoring: 'qunckkk'/",
"in Perl 5.10, DynaLoader warns about the incorrect version string" );
eval qq{ package $module; XSLoader::load('$module'); };
is( $@, '', "XSLoader::load($module)");
eval qq{ package $module; $modules{$module}; };
}
}
|
