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