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