Perl 5.12.2 from CPAN

2 files changed, 61 insertions, 127 deletions

diff --git a/gnu/usr.bin/perl/dist/XSLoader/XSLoader_pm.PL b/gnu/usr.bin/perl/dist/XSLoader/XSLoader_pm.PL
index e382058a04d..a258f6ea51a 100644
--- a/gnu/usr.bin/perl/dist/XSLoader/XSLoader_pm.PL
+++ b/gnu/usr.bin/perl/dist/XSLoader/XSLoader_pm.PL
@@ -1,7 +1,12 @@
 use strict;
 use Config;
-# We require DynaLoader to make sure that mod2fname is loaded
-eval { require DynaLoader };
+
+sub to_string {
+    my ($value) = @_;
+    $value =~ s/\\/\\\\/g;
+    $value =~ s/'/\\'/g;
+    return "'$value'";
+}
 
 1 while unlink "XSLoader.pm";
 open OUT, ">XSLoader.pm" or die $!;
@@ -10,35 +15,21 @@ print OUT <<'EOT';
 
 package XSLoader;
 
-$VERSION = "0.17";
+$VERSION = "0.10";
 
 #use strict;
 
-package DynaLoader;
+# enable debug/trace messages from DynaLoader perl code
+# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
 
 EOT
 
-# dlutils.c before 5.006 has this:
-#
-#    #ifdef DEBUGGING
-#        dl_debug = SvIV( perl_get_sv("DynaLoader::dl_debug", 0x04) );
-#    #endif
-#
-# where 0x04 is GV_ADDWARN, which causes a warning to be issued by the call
-# into XS below, if DynaLoader.pm hasn't been loaded.
-# It was changed to 0 in the commit(s) that added XSLoader to the core
-# (9cf41c4d23a47c8b and its parent 9426adcd48655815)
-# Hence to backport XSLoader to work silently with earlier DynaLoaders we need
-# to ensure that the variable exists:
-
-print OUT <<'EOT' if $] < 5.006;
+print OUT '  my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;
 
-# enable debug/trace messages from DynaLoader perl code
-$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
+print OUT <<'EOT';
 
-EOT
+package DynaLoader;
 
-print OUT <<'EOT';
 # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
 # NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
 boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
@@ -48,19 +39,15 @@ package XSLoader;
 sub load {
     package DynaLoader;
 
-    my ($module, $modlibname) = caller();
+    die q{XSLoader::load('Your::Module', $Your::Module::VERSION)} unless @_;
 
-    if (@_) {
-        $module = $_[0];
-    } else {
-        $_[0] = $module;
-    }
+    my($module) = $_[0];
 
     # work with static linking too
     my $boots = "$module\::bootstrap";
     goto &$boots if defined &$boots;
 
-    goto \&XSLoader::bootstrap_inherit unless $module and defined &dl_load_file;
+    goto retry unless $module and defined &dl_load_file;
 
     my @modparts = split(/::/,$module);
     my $modfname = $modparts[-1];
@@ -84,17 +71,10 @@ EOT
 
 print OUT <<'EOT';
     my $modpname = join('/',@modparts);
+    my $modlibname = (caller())[1];
     my $c = @modparts;
-    $modlibname =~ s,[\\/][^\\/]+$,, while $c--;    # Q&D basename
-EOT
-
-my $dl_dlext = quotemeta($Config::Config{'dlext'});
-
-print OUT <<"EOT";
-    my \$file = "\$modlibname/auto/\$modpname/\$modfname.$dl_dlext";
-EOT
-
-print OUT <<'EOT';
+    $modlibname =~ s,[\\/][^\\/]+$,, while $c--;	# Q&D basename
+    my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
 
 #   print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
 
@@ -107,7 +87,7 @@ print OUT <<'EOT';
         warn "$bs: $@\n" if $@;
     }
 
-    goto \&XSLoader::bootstrap_inherit if not -f $file or -s $bs;
+    goto retry if not -f $file or -s $bs;
 
     my $bootname = "boot_$module";
     $bootname =~ s/\W/_/g;
@@ -158,26 +138,15 @@ print OUT <<'EOT';
     # See comment block above
     push(@DynaLoader::dl_shared_objects, $file); # record files loaded
     return &$xs(@_);
-}
-EOT
-
-# Can't test with DynaLoader->can('bootstrap_inherit') when building in the
-# core, as XSLoader gets built before DynaLoader.
 
-if ($] >= 5.006) {
-    print OUT <<'EOT';
-
-sub bootstrap_inherit {
-    require DynaLoader;
-    goto \&DynaLoader::bootstrap_inherit;
+  retry:
+    my $bootstrap_inherit = DynaLoader->can('bootstrap_inherit') || 
+                            XSLoader->can('bootstrap_inherit');
+    goto &$bootstrap_inherit;
 }
 
-EOT
-} else {
-    print OUT <<'EOT';
-
+# Versions of DynaLoader prior to 5.6.0 don't have this function.
 sub bootstrap_inherit {
-    # Versions of DynaLoader prior to 5.6.0 don't have bootstrap_inherit.
     package DynaLoader;
 
     my $module = $_[0];
@@ -188,10 +157,6 @@ sub bootstrap_inherit {
     DynaLoader::bootstrap(@_);
 }
 
-EOT
-}
-
-print OUT <<'EOT';
 1;
 
 
@@ -203,14 +168,14 @@ XSLoader - Dynamically load C libraries into Perl code
 
 =head1 VERSION
 
-Version 0.17
+Version 0.10
 
 =head1 SYNOPSIS
 
     package YourPackage;
-    require XSLoader;
+    use XSLoader;
 
-    XSLoader::load();
+    XSLoader::load 'YourPackage', $YourPackage::VERSION;
 
 =head1 DESCRIPTION
 
@@ -259,13 +224,6 @@ If no C<$VERSION> was specified on the C<bootstrap> line, the last line becomes
 
     XSLoader::load 'YourPackage';
 
-If the call to C<load> is from C<YourPackage>, then that can be further
-simplified to
-
-    XSLoader::load();
-
-as C<load> will use C<caller> to determine the package.
-
 =head2 Backward compatible boilerplate
 
 If you want to have your cake and eat it too, you need a more complicated
@@ -291,7 +249,7 @@ C<use XSLoader> by C<require>, so the compiler does not know that a function
 C<XSLoader::load()> is present.
 
 This boilerplate uses the low-overhead C<XSLoader> if present; if used with
-an antique Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>.
+an antic Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>.
 
 =head1 Order of initialization: early load()
 
@@ -306,22 +264,18 @@ in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>).  If this
 Perl code makes calls into this XS code, and/or this XS code makes calls to
 the Perl code, one should be careful with the order of initialization.
 
-The call to C<XSLoader::load()> (or C<bootstrap()>) calls the module's
-bootstrap code. For modules build by F<xsubpp> (nearly all modules) this
-has three side effects:
+The call to C<XSLoader::load()> (or C<bootstrap()>) has three side effects:
 
 =over
 
 =item *
 
-A sanity check is done to ensure that the versions of the F<.pm> and the
-(compiled) F<.xs> parts are compatible. If C<$VERSION> was specified, this
-is used for the check. If not specified, it defaults to
-C<$XS_VERSION // $VERSION> (in the module's namespace)
+if C<$VERSION> was specified, a sanity check is done to ensure that the
+versions of the F<.pm> and the (compiled) F<.xs> parts are compatible;
 
 =item *
 
-the XSUBs are made accessible from Perl
+the XSUBs are made accessible from Perl;
 
 =item *
 
@@ -399,8 +353,14 @@ B<(W)> As the message says, some symbols stay undefined although the
 extension module was correctly loaded and initialised. The list of undefined
 symbols follows.
 
+=item C<XSLoader::load('Your::Module', $Your::Module::VERSION)>
+
+B<(F)> You tried to invoke C<load()> without any argument. You must supply
+a module name, and optionally its version.
+
 =back
 
+
 =head1 LIMITATIONS
 
 To reduce the overhead as much as possible, only one possible location
@@ -414,12 +374,6 @@ may have much more overhead than running the same extensions after
 C<make install>.
 
 
-=head1 KNOWN BUGS
-
-The new simpler way to call C<XSLoader::load()> with no arguments at all
-does not work on Perl 5.8.4 and 5.8.5.
-
-
 =head1 BUGS
 
 Please report any bugs or feature requests via the perlbug(1) utility.
@@ -442,7 +396,7 @@ Previous maintainer was Michael G Schwern <schwern@pobox.com>.
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright (C) 1990-2011 by Larry Wall and others.
+Copyright (C) 1990-2007 by Larry Wall and others.
 
 This program is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
diff --git a/gnu/usr.bin/perl/dist/XSLoader/t/XSLoader.t b/gnu/usr.bin/perl/dist/XSLoader/t/XSLoader.t
index 20ca32bb46f..211c4d84553 100755
--- a/gnu/usr.bin/perl/dist/XSLoader/t/XSLoader.t
+++ b/gnu/usr.bin/perl/dist/XSLoader/t/XSLoader.t
@@ -5,13 +5,12 @@ use Config;
 
 my $db_file;
 BEGIN {
-    if (not eval "use Test::More; 1") {
+    eval "use Test::More";
+    if ($@) {
         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/) {
@@ -25,15 +24,13 @@ 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' =>                  # 5.6
-                                   $] > 5.014
-                                     ? 'bsd_glob' : 'doglob') |,
+    '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) * 3 + 8;
+plan tests => keys(%modules) * 3 + 5;
 
 # Try to load the module
 use_ok( 'XSLoader' );
@@ -43,31 +40,18 @@ can_ok( 'XSLoader' => 'load' );
 can_ok( 'XSLoader' => 'bootstrap_inherit' );
 
 # Check error messages
-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");
+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" );
 }
 
 # Now try to load well known XS modules
@@ -75,11 +59,14 @@ 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", 3 if $extensions !~ /\b$module\b/;
+        skip "$module not available", 4 if $extensions !~ /\b$module\b/;
 
         eval qq{ package $module; XSLoader::load('$module', "12345678"); };
-        like( $@, "/^$module object version \\S+ does not match bootstrap parameter 12345678/",
+        like( $@, "/^$module object version \\S+ does not match bootstrap parameter (?:12345678|0)/",
                 "calling XSLoader::load() with a XS module and an incorrect version" );
 
         eval qq{ package $module; XSLoader::load('$module'); };
@@ -89,10 +76,3 @@ 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';
-}