FAQ sync

[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / t / DynaLoader.t

diff --git a/ext/DynaLoader/t/DynaLoader.t b/ext/DynaLoader/t/DynaLoader.t
index ad8dc45..a698a8f 100644 (file)
--- a/ext/DynaLoader/t/DynaLoader.t
+++ b/ext/DynaLoader/t/DynaLoader.t
@@ -12,16 +12,28 @@ use Config;
 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 => 27 + keys(%modules) * 2;
+plan tests => 22 + keys(%modules) * 3;
 
 
 # Try to load the module
@@ -36,7 +48,10 @@ 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
+SKIP: {
+    skip "unloading unsupported on $^O", 1 if ($^O eq 'VMS' || $^O eq 'darwin');
+    can_ok( 'DynaLoader' => 'dl_unload_file'          ); # defined in XS section
+}
 
 TODO: {
 local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
@@ -64,25 +79,46 @@ like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
 eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
 is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );     # is this expected ?
 
-eval { DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
-is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );
-like( DynaLoader::dl_error(), q{/egg_bacon_sausage_and_spam/}, 
-        "calling DynaLoader::dl_load_file() with a package without binary object" );
+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'" );
 
-# ... 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)" );
+# 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()
+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" );
     }
@@ -94,9 +130,12 @@ is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of it
 
 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" );
+  }
 }