DynaLoader.t revision 1.5
1#!/usr/bin/perl -wT 2 3use strict; 4use warnings; 5 6use Config; 7push @INC, '.'; 8if (-f 't/test.pl') { 9 require './t/test.pl'; 10} else { 11 require '../../t/test.pl'; 12} 13 14my %modules; 15 16my $db_file; 17BEGIN { 18 use Config; 19 foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) { 20 if ($Config{extensions} =~ /\b$_\b/) { 21 $db_file = $_; 22 last; 23 } 24 } 25} 26 27%modules = ( 28 # ModuleName => q| code to check that it was loaded |, 29 'List::Util' => q| ::is( ref List::Util->can('first'), 'CODE' ) |, # 5.7.2 30 'Cwd' => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |, # 5.7 ? 31 'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |, # 5.6 32 $db_file => q| ::is( ref $db_file->can('TIEHASH'), 'CODE' ) |, # 5.0 33 'Socket' => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |, # 5.0 34 'Time::HiRes' => q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |, # 5.7.3 35); 36 37plan (26 + keys(%modules) * 3); 38 39# Try to load the module 40use_ok( 'DynaLoader' ); 41 42# Some tests need to be skipped on old Darwin versions. 43# Commit ce12ed1954 added the skip originally, without specifying which 44# darwin version needed it. I know OS X 10.6 (Snow Leopard; darwin 10) 45# supports it, so skip anything before that. 46my $old_darwin = $^O eq 'darwin' && ($Config{osvers} =~ /^(\d+)/)[0] < 10; 47 48# Check functions 49can_ok( 'DynaLoader' => 'bootstrap' ); # defined in Perl section 50can_ok( 'DynaLoader' => 'dl_load_flags' ); # defined in Perl section 51can_ok( 'DynaLoader' => 'dl_error' ); # defined in XS section 52if ($Config{usedl}) { 53 can_ok( 'DynaLoader' => 'dl_find_symbol' ); # defined in XS section 54 can_ok( 'DynaLoader' => 'dl_install_xsub' ); # defined in XS section 55 can_ok( 'DynaLoader' => 'dl_load_file' ); # defined in XS section 56 can_ok( 'DynaLoader' => 'dl_undef_symbols' ); # defined in XS section 57 SKIP: { 58 skip( "unloading unsupported on $^O", 1 ) if ($old_darwin || $^O eq 'VMS'); 59 can_ok( 'DynaLoader' => 'dl_unload_file' ); # defined in XS section 60 } 61} else { 62 foreach my $symbol (qw(dl_find_symbol dl_install_sub dl_load_file 63 dl_undef_symbols dl_unload_file)) { 64 is(DynaLoader->can($symbol), undef, 65 "Without dynamic loading, DynaLoader should not have $symbol"); 66 } 67} 68 69can_ok( 'DynaLoader' => 'dl_expandspec' ); 70can_ok( 'DynaLoader' => 'dl_findfile' ); 71can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); 72 73 74# Check error messages 75# .. for bootstrap() 76eval { DynaLoader::bootstrap() }; 77like( $@, qr/^Usage: DynaLoader::bootstrap\(module\)/, 78 "calling DynaLoader::bootstrap() with no argument" ); 79 80eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") }; 81if ($Config{usedl}) { 82 like( $@, qr/^Can't locate loadable object for module egg_bacon_sausage_and_spam/, 83 "calling DynaLoader::bootstrap() with a package without binary object" ); 84} else { 85 like( $@, qr/^Can't load module egg_bacon_sausage_and_spam/, 86 "calling DynaLoader::bootstrap() with a package without binary object" ); 87} 88 89# .. for dl_load_file() 90SKIP: { 91 skip( "no dl_load_file with dl_none.xs", 2 ) unless $Config{usedl}; 92 eval { DynaLoader::dl_load_file() }; 93 like( $@, qr/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/, 94 "calling DynaLoader::dl_load_file() with no argument" ); 95 96 eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) }; 97 is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" ); # is this expected ? 98} 99 100my ($dlhandle, $dlerr); 101eval { $dlhandle = DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") }; 102$dlerr = DynaLoader::dl_error(); 103SKIP: { 104 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'; 105 ok( !$dlhandle, "calling DynaLoader::dl_load_file() without an existing library should fail" ); 106} 107ok( defined $dlerr, "dl_error() returning an error message: '$dlerr'" ); 108 109# Checking for any particular error messages or numeric codes 110# is very unportable, please do not try to do that. A failing 111# dl_load_file() is not even guaranteed to set the $! or the $^E. 112 113# ... dl_findfile() 114SKIP: { 115 my @files = (); 116 eval { @files = DynaLoader::dl_findfile("c") }; 117 is( $@, '', "calling dl_findfile()" ); 118 # Some platforms are known to not have a "libc" 119 # (not at least by that name) that the dl_findfile() 120 # could find. 121 skip( "dl_findfile test not appropriate on $^O", 1 ) 122 if $^O =~ /(win32|vms|openbsd|bitrig|cygwin|vos|os390)/i; 123 # Play safe and only try this test if this system 124 # looks pretty much Unix-like. 125 skip( "dl_findfile test not appropriate on $^O", 1 ) 126 unless -d '/usr' && -f '/bin/ls'; 127 skip( "dl_findfile test not always appropriate when cross-compiling", 1 ) 128 if $Config{usecrosscompile}; 129 cmp_ok( scalar @files, '>=', 1, "array should contain one result or more: libc => (@files)" ); 130} 131 132# Now try to load well known XS modules 133my $extensions = $Config{'dynamic_ext'}; 134$extensions =~ s|/|::|g; 135 136for my $module (sort keys %modules) { 137 SKIP: { 138 if ($extensions !~ /\b$module\b/) { 139 delete($modules{$module}); 140 skip( "$module not available", 3); 141 } 142 eval "use $module"; 143 is( $@, '', "loading $module" ); 144 } 145} 146 147# checking internal consistency 148is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" ); 149is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" ); 150 151my @loaded_modules = @DynaLoader::dl_modules; 152for my $libref (reverse @DynaLoader::dl_librefs) { 153SKIP: { 154 skip( "unloading unsupported on $^O", 2 ) 155 if ($old_darwin || $^O eq 'VMS'); 156 my $module = pop @loaded_modules; 157 skip( "File::Glob sets PL_opfreehook", 2 ) if $module eq 'File::Glob'; 158 my $r = eval { DynaLoader::dl_unload_file($libref) }; 159 is( $@, '', "calling dl_unload_file() for $module" ); 160 is( $r, 1, " - unload was successful" ); 161 } 162} 163 164SKIP: { 165 skip( "mod2fname not defined on this platform", 4 ) 166 unless defined &DynaLoader::mod2fname && $Config{d_libname_unique}; 167 168 is( 169 DynaLoader::mod2fname(["Hash", "Util"]), 170 "PL_Hash__Util", 171 "mod2fname + libname_unique works" 172 ); 173 174 is( 175 DynaLoader::mod2fname([("Hash", "Util") x 25]), 176 "PL_" . join("_", ("Hash", "Util")x25), 177 "mod2fname + libname_unique collapses double __'s for long names" 178 ); 179 180 is( 181 DynaLoader::mod2fname([("Haash", "Uttil") x 25]), 182 "PL_" . join("_", ("HAsh", "UTil")x25), 183 "mod2fname + libname_unique collapses repeated characters for long names" 184 ); 185 186 is( 187 DynaLoader::mod2fname([("Hash", "Util")x30]), 188 substr(("PL_" . join("_", ("Hash", "Util")x30)), 0, 255 - (length($Config::Config{dlext})+1)), 189 "mod2fname + libname_unique correctly truncates long names" 190 ); 191} 192 193