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
|
#!/usr/bin/perl -wT
use strict;
use Config;
use Test::More;
my %modules;
my $db_file;
BEGIN {
use Config;
foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) {
if ($Config{extensions} =~ /\b$_\b/) {
$db_file = $_;
last;
}
}
}
%modules = (
# ModuleName => q| code to check that it was loaded |,
'List::Util' => q| ::is( ref List::Util->can('first'), 'CODE' ) |, # 5.7.2
'Cwd' => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |, # 5.7 ?
'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |, # 5.6
$db_file => q| ::is( ref $db_file->can('TIEHASH'), 'CODE' ) |, # 5.0
'Socket' => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |, # 5.0
'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |, # 5.7.3
);
plan tests => 22 + keys(%modules) * 3;
# Try to load the module
use_ok( 'DynaLoader' );
# Check functions
can_ok( 'DynaLoader' => 'bootstrap' ); # defined in Perl section
can_ok( 'DynaLoader' => 'dl_load_flags' ); # defined in Perl section
can_ok( 'DynaLoader' => 'dl_error' ); # defined in XS section
if ($Config{usedl}) {
can_ok( 'DynaLoader' => 'dl_find_symbol' ); # defined in XS section
can_ok( 'DynaLoader' => 'dl_install_xsub' ); # defined in XS section
can_ok( 'DynaLoader' => 'dl_load_file' ); # defined in XS section
can_ok( 'DynaLoader' => 'dl_undef_symbols' ); # defined in XS section
SKIP: {
skip "unloading unsupported on $^O", 1 if ($^O eq 'VMS' || $^O eq 'darwin');
can_ok( 'DynaLoader' => 'dl_unload_file' ); # defined in XS section
}
} else {
foreach my $symbol (qw(dl_find_symbol dl_install_sub dl_load_file
dl_undef_symbols dl_unload_file)) {
is(DynaLoader->can($symbol), undef,
"Without dynamic loading, DynaLoader should not have $symbol");
}
}
can_ok( 'DynaLoader' => 'dl_expandspec' );
can_ok( 'DynaLoader' => 'dl_findfile' );
can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' );
# Check error messages
# .. for bootstrap()
eval { DynaLoader::bootstrap() };
like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
"calling DynaLoader::bootstrap() with no argument" );
eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
if ($Config{usedl}) {
like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
"calling DynaLoader::bootstrap() with a package without binary object" );
} else {
like( $@, q{/^Can't load module egg_bacon_sausage_and_spam/},
"calling DynaLoader::bootstrap() with a package without binary object" );
}
# .. for dl_load_file()
SKIP: {
skip "no dl_load_file with dl_none.xs", 2 unless $Config{usedl};
eval { DynaLoader::dl_load_file() };
like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
"calling DynaLoader::dl_load_file() with no argument" );
eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" ); # is this expected ?
}
my ($dlhandle, $dlerr);
eval { $dlhandle = DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
$dlerr = DynaLoader::dl_error();
SKIP: {
skip "dl_load_file() does not attempt to load file on VMS (and thus does not fail) when \@dl_require_symbols is empty", 1 if $^O eq 'VMS';
ok( !$dlhandle, "calling DynaLoader::dl_load_file() without an existing library should fail" );
}
ok( defined $dlerr, "dl_error() returning an error message: '$dlerr'" );
# Checking for any particular error messages or numeric codes
# is very unportable, please do not try to do that. A failing
# dl_load_file() is not even guaranteed to set the $! or the $^E.
# ... dl_findfile()
SKIP: {
my @files = ();
eval { @files = DynaLoader::dl_findfile("c") };
is( $@, '', "calling dl_findfile()" );
# Some platforms are known to not have a "libc"
# (not at least by that name) that the dl_findfile()
# could find.
skip "dl_findfile test not appropriate on $^O", 1
if $^O =~ /(win32|vms|openbsd|cygwin)/i;
# Play safe and only try this test if this system
# looks pretty much Unix-like.
skip "dl_findfile test not appropriate on $^O", 1
unless -d '/usr' && -f '/bin/ls';
cmp_ok( scalar @files, '>=', 1, "array should contain one result result or more: libc => (@files)" );
}
# Now try to load well known XS modules
my $extensions = $Config{'dynamic_ext'};
$extensions =~ s|/|::|g;
for my $module (sort keys %modules) {
SKIP: {
if ($extensions !~ /\b$module\b/) {
delete($modules{$module});
skip "$module not available", 3;
}
eval "use $module";
is( $@, '', "loading $module" );
}
}
# checking internal consistency
is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
my @loaded_modules = @DynaLoader::dl_modules;
for my $libref (reverse @DynaLoader::dl_librefs) {
SKIP: {
skip "unloading unsupported on $^O", 2 if ($^O eq 'VMS' || $^O eq 'darwin');
my $module = pop @loaded_modules;
my $r = eval { DynaLoader::dl_unload_file($libref) };
is( $@, '', "calling dl_unload_file() for $module" );
is( $r, 1, " - unload was successful" );
}
}
|
