use strict;
use Config;
-use Errno qw(ENOENT);
use Test::More;
my %modules;
+my $db_file;
+BEGIN {
+ use Config;
+ foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) {
+ if ($Config{extensions} =~ /\b$_\b/) {
+ $db_file = $_;
+ last;
+ }
+ }
+}
+
%modules = (
# ModuleName => q| code to check that it was loaded |,
+ 'List::Util' => q| ::is( ref List::Util->can('first'), 'CODE' ) |, # 5.7.2
'Cwd' => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |, # 5.7 ?
'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |, # 5.6
- 'SDBM_File' => q| ::is( ref SDBM_File->can('TIEHASH'), 'CODE' ) |, # 5.0
+ $db_file => q| ::is( ref $db_file->can('TIEHASH'), 'CODE' ) |, # 5.0
'Socket' => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |, # 5.0
'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |, # 5.7.3
);
-plan tests => 28 + keys(%modules) * 2;
+plan tests => 22 + keys(%modules) * 3;
# Try to load the module
# Check functions
can_ok( 'DynaLoader' => 'bootstrap' ); # defined in Perl section
-can_ok( 'DynaLoader' => 'dl_error' ); # defined in XS section
-can_ok( 'DynaLoader' => 'dl_find_symbol' ); # defined in XS section
-can_ok( 'DynaLoader' => 'dl_install_xsub' ); # defined in XS section
-can_ok( 'DynaLoader' => 'dl_load_file' ); # defined in XS section
can_ok( 'DynaLoader' => 'dl_load_flags' ); # defined in Perl section
-can_ok( 'DynaLoader' => 'dl_undef_symbols' ); # defined in XS section
-can_ok( 'DynaLoader' => 'dl_unload_file' ); # defined in XS section
+can_ok( 'DynaLoader' => 'dl_error' ); # defined in XS section
+if ($Config{usedl}) {
+ can_ok( 'DynaLoader' => 'dl_find_symbol' ); # defined in XS section
+ can_ok( 'DynaLoader' => 'dl_install_xsub' ); # defined in XS section
+ can_ok( 'DynaLoader' => 'dl_load_file' ); # defined in XS section
+ can_ok( 'DynaLoader' => 'dl_undef_symbols' ); # defined in XS section
+ SKIP: {
+ skip "unloading unsupported on $^O", 1 if ($^O eq 'VMS' || $^O eq 'darwin');
+ can_ok( 'DynaLoader' => 'dl_unload_file' ); # defined in XS section
+ }
+} else {
+ foreach my $symbol (qw(dl_find_symbol dl_install_sub dl_load_file
+ dl_undef_symbols dl_unload_file)) {
+ is(DynaLoader->can($symbol), undef,
+ "Without dynamic loading, DynaLoader should not have $symbol");
+ }
+}
TODO: {
local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
"calling DynaLoader::bootstrap() with no argument" );
eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
-like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
+if ($Config{usedl}) {
+ like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
"calling DynaLoader::bootstrap() with a package without binary object" );
+} else {
+ like( $@, q{/^Can't load module egg_bacon_sausage_and_spam/},
+ "calling DynaLoader::bootstrap() with a package without binary object" );
+}
# .. for dl_load_file()
-eval { DynaLoader::dl_load_file() };
-like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
- "calling DynaLoader::dl_load_file() with no argument" );
+SKIP: {
+ skip "no dl_load_file with dl_none.xs", 2 unless $Config{usedl};
+ eval { DynaLoader::dl_load_file() };
+ like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
+ "calling DynaLoader::dl_load_file() with no argument" );
+
+ eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
+ is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" ); # is this expected ?
+}
-eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
-is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" ); # is this expected ?
+my ($dlhandle, $dlerr);
+eval { $dlhandle = DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
+$dlerr = DynaLoader::dl_error();
+SKIP: {
+ 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';
+ ok( !$dlhandle, "calling DynaLoader::dl_load_file() without an existing library should fail" );
+}
+ok( defined $dlerr, "dl_error() returning an error message: '$dlerr'" );
-eval { DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
-is( $@, '', "calling DynaLoader::dl_load_file() with a package without binary object" );
-is( 0+$!, ENOENT, "checking errno value" );
-like( DynaLoader::dl_error(), "/$!/", "checking error message returned by dl_error()" );
+# Checking for any particular error messages or numeric codes
+# is very unportable, please do not try to do that. A failing
+# dl_load_file() is not even guaranteed to set the $! or the $^E.
# ... dl_findfile()
-my @files = ();
-eval { @files = DynaLoader::dl_findfile("c") };
-is( $@, '', "calling dl_findfile()" );
-cmp_ok( scalar @files, '>=', 1, " - array should contain one result result or more: libc => (@files)" );
-
+SKIP: {
+ my @files = ();
+ eval { @files = DynaLoader::dl_findfile("c") };
+ is( $@, '', "calling dl_findfile()" );
+ # Some platforms are known to not have a "libc"
+ # (not at least by that name) that the dl_findfile()
+ # could find.
+ skip "dl_findfile test not appropriate on $^O", 1
+ if $^O =~ /(win32|vms|openbsd|cygwin)/i;
+ # Play safe and only try this test if this system
+ # looks pretty much Unix-like.
+ skip "dl_findfile test not appropriate on $^O", 1
+ unless -d '/usr' && -f '/bin/ls';
+ cmp_ok( scalar @files, '>=', 1, "array should contain one result result or more: libc => (@files)" );
+}
# Now try to load well known XS modules
-my $extensions = $Config{'extensions'};
+my $extensions = $Config{'dynamic_ext'};
$extensions =~ s|/|::|g;
for my $module (sort keys %modules) {
SKIP: {
- skip "$module not available", 2 if $extensions !~ /\b$module\b/;
+ if ($extensions !~ /\b$module\b/) {
+ delete($modules{$module});
+ skip "$module not available", 3;
+ }
eval "use $module";
is( $@, '', "loading $module" );
}
my @loaded_modules = @DynaLoader::dl_modules;
for my $libref (reverse @DynaLoader::dl_librefs) {
+ SKIP: {
+ skip "unloading unsupported on $^O", 2 if ($^O eq 'VMS' || $^O eq 'darwin');
my $module = pop @loaded_modules;
my $r = eval { DynaLoader::dl_unload_file($libref) };
is( $@, '', "calling dl_unload_file() for $module" );
is( $r, 1, " - unload was successful" );
+ }
}
projects / p5sagit/p5-mst-13.2.git / blobdiff