Commit | Line | Data |
51254d33 |
1 | #!/usr/bin/perl -wT |
2 | |
3 | BEGIN { |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = '../lib'; |
7 | } |
8 | } |
9 | |
10 | use strict; |
11 | use Config; |
12 | use Test::More; |
13 | my %modules; |
14 | |
494364e0 |
15 | my $db_file; |
16 | BEGIN { |
17 | use Config; |
18 | foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) { |
19 | if ($Config{extensions} =~ /\b$_\b/) { |
20 | $db_file = $_; |
21 | last; |
22 | } |
23 | } |
24 | } |
25 | |
51254d33 |
26 | %modules = ( |
27 | # ModuleName => q| code to check that it was loaded |, |
05a4b9b1 |
28 | 'List::Util' => q| ::is( ref List::Util->can('first'), 'CODE' ) |, # 5.7.2 |
51254d33 |
29 | 'Cwd' => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |, # 5.7 ? |
30 | 'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |, # 5.6 |
494364e0 |
31 | $db_file => q| ::is( ref $db_file->can('TIEHASH'), 'CODE' ) |, # 5.0 |
51254d33 |
32 | 'Socket' => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |, # 5.0 |
33 | 'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |, # 5.7.3 |
34 | ); |
35 | |
05a4b9b1 |
36 | plan tests => 22 + keys(%modules) * 3; |
51254d33 |
37 | |
38 | |
39 | # Try to load the module |
40 | use_ok( 'DynaLoader' ); |
41 | |
42 | |
43 | # Check functions |
44 | can_ok( 'DynaLoader' => 'bootstrap' ); # defined in Perl section |
45 | can_ok( 'DynaLoader' => 'dl_error' ); # defined in XS section |
46 | can_ok( 'DynaLoader' => 'dl_find_symbol' ); # defined in XS section |
47 | can_ok( 'DynaLoader' => 'dl_install_xsub' ); # defined in XS section |
48 | can_ok( 'DynaLoader' => 'dl_load_file' ); # defined in XS section |
49 | can_ok( 'DynaLoader' => 'dl_load_flags' ); # defined in Perl section |
50 | can_ok( 'DynaLoader' => 'dl_undef_symbols' ); # defined in XS section |
a555bf5f |
51 | SKIP: { |
ce12ed19 |
52 | skip "unloading unsupported on $^O", 1 if ($^O eq 'VMS' || $^O eq 'darwin'); |
a555bf5f |
53 | can_ok( 'DynaLoader' => 'dl_unload_file' ); # defined in XS section |
54 | } |
51254d33 |
55 | |
56 | TODO: { |
57 | local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions"; |
58 | can_ok( 'DynaLoader' => 'dl_expandspec' ); # defined in AutoLoaded section |
59 | can_ok( 'DynaLoader' => 'dl_findfile' ); # defined in AutoLoaded section |
60 | can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); # defined in AutoLoaded section |
61 | } |
62 | |
63 | |
64 | # Check error messages |
65 | # .. for bootstrap() |
66 | eval { DynaLoader::bootstrap() }; |
67 | like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/}, |
68 | "calling DynaLoader::bootstrap() with no argument" ); |
69 | |
70 | eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") }; |
71 | like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/}, |
72 | "calling DynaLoader::bootstrap() with a package without binary object" ); |
73 | |
74 | # .. for dl_load_file() |
75 | eval { DynaLoader::dl_load_file() }; |
76 | like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/}, |
77 | "calling DynaLoader::dl_load_file() with no argument" ); |
78 | |
69c6e315 |
79 | eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) }; |
51254d33 |
80 | is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" ); # is this expected ? |
81 | |
f3c90b36 |
82 | my ($dlhandle, $dlerr); |
83 | eval { $dlhandle = DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") }; |
c3026122 |
84 | $dlerr = DynaLoader::dl_error(); |
a555bf5f |
85 | SKIP: { |
86 | 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'; |
87 | ok( !$dlhandle, "calling DynaLoader::dl_load_file() without an existing library should fail" ); |
88 | } |
f3c90b36 |
89 | ok( defined $dlerr, "dl_error() returning an error message: '$dlerr'" ); |
51254d33 |
90 | |
f3c90b36 |
91 | # Checking for any particular error messages or numeric codes |
92 | # is very unportable, please do not try to do that. A failing |
93 | # dl_load_file() is not even guaranteed to set the $! or the $^E. |
51254d33 |
94 | |
c3026122 |
95 | # ... dl_findfile() |
96 | SKIP: { |
97 | my @files = (); |
98 | eval { @files = DynaLoader::dl_findfile("c") }; |
99 | is( $@, '', "calling dl_findfile()" ); |
f3c90b36 |
100 | # Some platforms are known to not have a "libc" |
101 | # (not at least by that name) that the dl_findfile() |
102 | # could find. |
103 | skip "dl_findfile test not appropriate on $^O", 1 |
d53b420d |
104 | if $^O =~ /(win32|vms|openbsd|cygwin)/i; |
f3c90b36 |
105 | # Play safe and only try this test if this system |
106 | # looks pretty much Unix-like. |
107 | skip "dl_findfile test not appropriate on $^O", 1 |
108 | unless -d '/usr' && -f '/bin/ls'; |
109 | cmp_ok( scalar @files, '>=', 1, "array should contain one result result or more: libc => (@files)" ); |
c3026122 |
110 | } |
51254d33 |
111 | |
112 | # Now try to load well known XS modules |
3fa583e0 |
113 | my $extensions = $Config{'dynamic_ext'}; |
51254d33 |
114 | $extensions =~ s|/|::|g; |
115 | |
116 | for my $module (sort keys %modules) { |
117 | SKIP: { |
0aad8255 |
118 | if ($extensions !~ /\b$module\b/) { |
119 | delete($modules{$module}); |
120 | skip "$module not available", 3; |
121 | } |
51254d33 |
122 | eval "use $module"; |
123 | is( $@, '', "loading $module" ); |
124 | } |
125 | } |
126 | |
127 | # checking internal consistency |
128 | is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" ); |
129 | is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" ); |
130 | |
131 | my @loaded_modules = @DynaLoader::dl_modules; |
132 | for my $libref (reverse @DynaLoader::dl_librefs) { |
a555bf5f |
133 | SKIP: { |
ce12ed19 |
134 | skip "unloading unsupported on $^O", 2 if ($^O eq 'VMS' || $^O eq 'darwin'); |
51254d33 |
135 | my $module = pop @loaded_modules; |
136 | my $r = eval { DynaLoader::dl_unload_file($libref) }; |
137 | is( $@, '', "calling dl_unload_file() for $module" ); |
138 | is( $r, 1, " - unload was successful" ); |
a555bf5f |
139 | } |
51254d33 |
140 | } |
141 | |