From: Sébastien Aperghis-Tramoni <sebastien@aperghis.net>
Date: Sun, 21 Sep 2008 18:31:48 +0000 (+0200)
Subject: Fwd: CPAN Upload: S/SA/SAPER/XSLoader-0.09.tar.gz
X-Git-Tag: accepted/trunk/20130322.191538~12771
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=73bf75527b21ab9feca5fa6f83433ec2ca12a84a;p=platform%2Fupstream%2Fperl.git

Fwd: CPAN Upload: S/SA/SAPER/XSLoader-0.09.tar.gz
Message-Id: <D065A3BF-289B-43D4-9F30-D316414C1923@free.fr>

p4raw-id: //depot/perl@34388
---

diff --git a/ext/DynaLoader/XSLoader_pm.PL b/ext/DynaLoader/XSLoader_pm.PL
index 14781de..712ac0e 100644
--- a/ext/DynaLoader/XSLoader_pm.PL
+++ b/ext/DynaLoader/XSLoader_pm.PL
@@ -15,7 +15,7 @@ print OUT <<'EOT';
 
 package XSLoader;
 
-$VERSION = "0.08";
+$VERSION = "0.09";
 
 #use strict;
 
@@ -44,8 +44,8 @@ sub load {
     my($module) = $_[0];
 
     # work with static linking too
-    my $b = "$module\::bootstrap";
-    goto &$b if defined &$b;
+    my $boots = "$module\::bootstrap";
+    goto &$boots if defined &$boots;
 
     goto retry unless $module and defined &dl_load_file;
 
@@ -81,6 +81,12 @@ print OUT <<'EOT';
     my $bs = $file;
     $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
 
+    if (-s $bs) { # only read file if it's not empty
+        print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
+        eval { do $bs; };
+        warn "$bs: $@\n" if $@;
+    }
+
     goto retry if not -f $file or -s $bs;
 
     my $bootname = "boot_$module";
@@ -127,7 +133,7 @@ print OUT <<'EOT';
     push(@DynaLoader::dl_modules, $module); # record loaded module
 
   boot:
-    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+    my $xs = dl_install_xsub($boots, $boot_symbol_ref, $file);
 
     # See comment block above
     push(@DynaLoader::dl_shared_objects, $file); # record files loaded
@@ -162,7 +168,7 @@ XSLoader - Dynamically load C libraries into Perl code
 
 =head1 VERSION
 
-Version 0.08
+Version 0.09
 
 =head1 SYNOPSIS
 
@@ -388,7 +394,9 @@ E<lt>sebastien@aperghis.netE<gt>.
 Previous maintainer was Michael G Schwern <schwern@pobox.com>.
 
 
-=head1 COPYRIGHT
+=head1 COPYRIGHT & LICENSE
+
+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/ext/DynaLoader/t/XSLoader.t b/ext/DynaLoader/t/XSLoader.t
index dea14cd..31a85cf 100644
--- a/ext/DynaLoader/t/XSLoader.t
+++ b/ext/DynaLoader/t/XSLoader.t
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -T
+#!perl -T
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
@@ -37,7 +37,7 @@ my %modules = (
     'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep'  ) |,  # 5.7.3
 );
 
-plan tests => keys(%modules) * 3 + 5;
+plan tests => keys(%modules) * 4 + 5;
 
 # Try to load the module
 use_ok( 'XSLoader' );
@@ -60,12 +60,17 @@ 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', "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)");