4 if( $ENV{PERL_CORE} ) {
18 foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) {
19 if ($Config{extensions} =~ /\b$_\b/) {
27 # ModuleName => q| code to check that it was loaded |,
28 'List::Util' => q| ::is( ref List::Util->can('first'), 'CODE' ) |, # 5.7.2
29 'Cwd' => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |, # 5.7 ?
30 'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |, # 5.6
31 $db_file => q| ::is( ref $db_file->can('TIEHASH'), 'CODE' ) |, # 5.0
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
36 plan tests => 22 + keys(%modules) * 3;
39 # Try to load the module
40 use_ok( 'DynaLoader' );
44 can_ok( 'DynaLoader' => 'bootstrap' ); # defined in Perl section
45 can_ok( 'DynaLoader' => 'dl_load_flags' ); # defined in Perl section
46 can_ok( 'DynaLoader' => 'dl_error' ); # defined in XS section
48 can_ok( 'DynaLoader' => 'dl_find_symbol' ); # defined in XS section
49 can_ok( 'DynaLoader' => 'dl_install_xsub' ); # defined in XS section
50 can_ok( 'DynaLoader' => 'dl_load_file' ); # defined in XS section
51 can_ok( 'DynaLoader' => 'dl_undef_symbols' ); # defined in XS section
53 skip "unloading unsupported on $^O", 1 if ($^O eq 'VMS' || $^O eq 'darwin');
54 can_ok( 'DynaLoader' => 'dl_unload_file' ); # defined in XS section
57 foreach my $symbol (qw(dl_find_symbol dl_install_sub dl_load_file
58 dl_undef_symbols dl_unload_file)) {
59 is(DynaLoader->can($symbol), undef,
60 "Without dynamic loading, DynaLoader should not have $symbol");
65 local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
66 can_ok( 'DynaLoader' => 'dl_expandspec' ); # defined in AutoLoaded section
67 can_ok( 'DynaLoader' => 'dl_findfile' ); # defined in AutoLoaded section
68 can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); # defined in AutoLoaded section
72 # Check error messages
74 eval { DynaLoader::bootstrap() };
75 like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
76 "calling DynaLoader::bootstrap() with no argument" );
78 eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
80 like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
81 "calling DynaLoader::bootstrap() with a package without binary object" );
83 like( $@, q{/^Can't load module egg_bacon_sausage_and_spam/},
84 "calling DynaLoader::bootstrap() with a package without binary object" );
87 # .. for dl_load_file()
89 skip "no dl_load_file with dl_none.xs", 2 unless $Config{usedl};
90 eval { DynaLoader::dl_load_file() };
91 like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
92 "calling DynaLoader::dl_load_file() with no argument" );
94 eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
95 is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" ); # is this expected ?
98 my ($dlhandle, $dlerr);
99 eval { $dlhandle = DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
100 $dlerr = DynaLoader::dl_error();
102 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';
103 ok( !$dlhandle, "calling DynaLoader::dl_load_file() without an existing library should fail" );
105 ok( defined $dlerr, "dl_error() returning an error message: '$dlerr'" );
107 # Checking for any particular error messages or numeric codes
108 # is very unportable, please do not try to do that. A failing
109 # dl_load_file() is not even guaranteed to set the $! or the $^E.
114 eval { @files = DynaLoader::dl_findfile("c") };
115 is( $@, '', "calling dl_findfile()" );
116 # Some platforms are known to not have a "libc"
117 # (not at least by that name) that the dl_findfile()
119 skip "dl_findfile test not appropriate on $^O", 1
120 if $^O =~ /(win32|vms|openbsd|cygwin)/i;
121 # Play safe and only try this test if this system
122 # looks pretty much Unix-like.
123 skip "dl_findfile test not appropriate on $^O", 1
124 unless -d '/usr' && -f '/bin/ls';
125 cmp_ok( scalar @files, '>=', 1, "array should contain one result result or more: libc => (@files)" );
128 # Now try to load well known XS modules
129 my $extensions = $Config{'dynamic_ext'};
130 $extensions =~ s|/|::|g;
132 for my $module (sort keys %modules) {
134 if ($extensions !~ /\b$module\b/) {
135 delete($modules{$module});
136 skip "$module not available", 3;
139 is( $@, '', "loading $module" );
143 # checking internal consistency
144 is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
145 is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
147 my @loaded_modules = @DynaLoader::dl_modules;
148 for my $libref (reverse @DynaLoader::dl_librefs) {
150 skip "unloading unsupported on $^O", 2 if ($^O eq 'VMS' || $^O eq 'darwin');
151 my $module = pop @loaded_modules;
152 my $r = eval { DynaLoader::dl_unload_file($libref) };
153 is( $@, '', "calling dl_unload_file() for $module" );
154 is( $r, 1, " - unload was successful" );