[perl #59208][PATCH 5.8.x] ext/DynaLoader/t/XSLoader.t assumes dynamic loading

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

diff --git a/ext/DynaLoader/t/XSLoader.t b/ext/DynaLoader/t/XSLoader.t
index 1654a2e..2c7479e 100644 (file)
--- a/ext/DynaLoader/t/XSLoader.t
+++ b/ext/DynaLoader/t/XSLoader.t
@@ -1,20 +1,87 @@
-#!/usr/bin/perl -w
+#!perl -T
 
 BEGIN {
-    chdir 't';
-#    @INC = '../lib';
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
 }
 
-use Test;
-plan tests => 4;
+use strict;
+use Config;
 
-use XSLoader;
-ok(1);
-ok( ref XSLoader->can('load') );
+my $db_file;
+BEGIN {
+    eval "use Test::More";
+    if ($@) {
+        print "1..0 # Skip: Test::More not available\n";
+        die "Test::More not available\n";
+    }
+
+    use Config;
+    foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) {
+        if ($Config{extensions} =~ /\b$_\b/) {
+            $db_file = $_;
+            last;
+        }
+    }
+}
+
+
+my %modules = (
+    # ModuleName  => q|code to check that it was loaded|,
+    'Cwd'        => q| ::can_ok( 'Cwd' => 'fastcwd'         ) |,  # 5.7 ?
+    'File::Glob' => q| ::can_ok( 'File::Glob' => 'doglob'   ) |,  # 5.6
+    $db_file     => q| ::can_ok( $db_file => 'TIEHASH'      ) |,  # 5.0
+    'Socket'     => q| ::can_ok( 'Socket' => 'inet_aton'    ) |,  # 5.0
+    'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep'  ) |,  # 5.7.3
+);
+
+plan tests => keys(%modules) * 4 + 5;
+
+# Try to load the module
+use_ok( 'XSLoader' );
+
+# Check functions
+can_ok( 'XSLoader' => 'load' );
+can_ok( 'XSLoader' => 'bootstrap_inherit' );
+
+# Check error messages
+eval { XSLoader::load() };
+like( $@, '/^XSLoader::load\(\'Your::Module\', \$Your::Module::VERSION\)/',
+        "calling XSLoader::load() with no argument" );
 
-eval { XSLoader::load(); };
-ok( $@ =~ /^XSLoader::load\('Your::Module', \$Your::Module::VERSION\)/ );
+eval q{ package Thwack; XSLoader::load('Thwack'); };
+if ($Config{usedl}) {
+ like( $@, q{/^Can't locate loadable object for module Thwack in @INC/},
+ "calling XSLoader::load() under a package with no XS part" );
+}
+else {
+ like( $@, q{/^Can't load module Thwack, dynamic loading not available in this perl./},
+ "calling XSLoader::load() under a package with no XS part" );
+}
+
+# Now try to load well known XS modules
+my $extensions = $Config{'extensions'};
+$extensions =~ s|/|::|g;
+
+for my $module (sort keys %modules) {
+    my $warnings = "";
+    local $SIG{__WARN__} = sub { $warnings = $_[0] };
+
+    SKIP: {
+        skip "$module not available", 4 if $extensions !~ /\b$module\b/;
+
+        eval qq{ package $module; XSLoader::load('$module', "qunckkk"); };
+        like( $@, "/^$module object version \\S+ does not match bootstrap parameter (?:qunckkk|0)/",  
+                "calling XSLoader::load() with a XS module and an incorrect version" );
+        like( $warnings, "/^\$|^Version string 'qunckkk' contains invalid data; ignoring: 'qunckkk'/", 
+                "in Perl 5.10, DynaLoader warns about the incorrect version string" );
+
+        eval qq{ package $module; XSLoader::load('$module'); };
+        is( $@, '',  "XSLoader::load($module)");
+
+        eval qq{ package $module; $modules{$module}; };
+    }
+}
 
-package SDBM_File;
-XSLoader::load('SDBM_File');
-::ok( ref SDBM_File->can('TIEHASH') );