1 files changed, 66 insertions, 21 deletions

diff --git a/gnu/usr.bin/perl/dist/XSLoader/t/XSLoader.t b/gnu/usr.bin/perl/dist/XSLoader/t/XSLoader.t
index 211c4d84553..d254f199f9b 100755
--- a/gnu/usr.bin/perl/dist/XSLoader/t/XSLoader.t
+++ b/gnu/usr.bin/perl/dist/XSLoader/t/XSLoader.t
@@ -5,12 +5,13 @@ use Config;
 
 my $db_file;
 BEGIN {
-    eval "use Test::More";
-    if ($@) {
+    if (not eval "use Test::More; 1") {
         print "1..0 # Skip: Test::More not available\n";
         die "Test::More not available\n";
     }
 
+    plan(skip_all => "these tests needs Perl 5.5+") if $] < 5.005;
+
     use Config;
     foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) {
         if ($Config{extensions} =~ /\b$_\b/) {
@@ -24,13 +25,15 @@ BEGIN {
 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
+    'File::Glob' => q| ::can_ok( 'File::Glob' =>                  # 5.6
+                                   $] > 5.014
+                                     ? 'bsd_glob' : 'doglob') |,
     $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) * 3 + 5;
+plan tests => keys(%modules) * 3 + 9;
 
 # Try to load the module
 use_ok( 'XSLoader' );
@@ -40,18 +43,31 @@ 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 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" );
+my @cases = (
+    [ 'Thwack', 'package Thwack; XSLoader::load(); 1'        ],
+    [ 'Zlott' , 'package Thwack; XSLoader::load("Zlott"); 1' ],
+);
+
+for my $case (@cases) {
+    my ($should_load, $codestr) = @$case;
+    my $diag;
+
+    # determine the expected diagnostic
+    if ($Config{usedl}) {
+        if ($case->[0] eq "Thwack" and ($] == 5.008004 or $] == 5.008005)) {
+            # these versions had bugs with chained C<goto &>
+            $diag = "Usage: DynaLoader::bootstrap\\(module\\)";
+        } else {
+            # normal diagnostic for a perl with dynamic loading
+            $diag = "Can't locate loadable object for module $should_load in \@INC";
+        }
+    } else {
+        # a perl with no dynamic loading
+        $diag = "Can't load module $should_load, dynamic loading not available in this perl.";
+    }
+
+    is(eval $codestr, undef, "eval '$codestr' should die");
+    like($@, qr/^$diag/, "calling XSLoader::load() under a package with no XS part");
 }
 
 # Now try to load well known XS modules
@@ -59,14 +75,11 @@ 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/;
+        skip "$module not available", 3 if $extensions !~ /\b$module\b/;
 
         eval qq{ package $module; XSLoader::load('$module', "12345678"); };
-        like( $@, "/^$module object version \\S+ does not match bootstrap parameter (?:12345678|0)/",
+        like( $@, "/^$module object version \\S+ does not match bootstrap parameter 12345678/",
                 "calling XSLoader::load() with a XS module and an incorrect version" );
 
         eval qq{ package $module; XSLoader::load('$module'); };
@@ -76,3 +89,35 @@ for my $module (sort keys %modules) {
     }
 }
 
+SKIP: {
+    skip "Needs 5.15.6", 1 unless $] > 5.0150051;
+    skip "List::Util not available", 1 if $extensions !~ /\bList::Util\b/;
+    eval 'package List::Util; XSLoader::load(__PACKAGE__, "version")';
+    like $@, "/^Invalid version format/",
+        'correct error msg for invalid versions';
+}
+
+SKIP: {
+  skip "File::Path not available", 1
+    unless eval { require File::Path };
+  my $name = "phooo$$";
+  File::Path::make_path("$name/auto/Foo/Bar");
+  open my $fh,
+    ">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}";
+  close $fh;
+  my $fell_back;
+  local *XSLoader::bootstrap_inherit = sub {
+    $fell_back++;
+    # Break out of the calling subs
+    goto the_test;
+  };
+  eval <<END;
+#line 1 $name
+package Foo::Bar;
+XSLoader::load("Foo::Bar");
+END
+ the_test:
+  ok $fell_back,
+    'XSLoader will not load relative paths based on (caller)[1]';
+  File::Path::remove_tree($name);
+}