Further simplify XSLoader .bs file handling

[perl5.git] / dist / XSLoader / XSLoader_pm.PL

diff --git a/dist/XSLoader/XSLoader_pm.PL b/dist/XSLoader/XSLoader_pm.PL
index 414eaf2..e095388 100644 (file)
--- a/dist/XSLoader/XSLoader_pm.PL
+++ b/dist/XSLoader/XSLoader_pm.PL
@@ -4,13 +4,14 @@ use Config;
 eval { require DynaLoader };
 
 1 while unlink "XSLoader.pm";
-open OUT, ">XSLoader.pm" or die $!;
+open OUT, '>', 'XSLoader.pm' or die $!;
 print OUT <<'EOT';
-# Generated from XSLoader.pm.PL (resolved %Config::Config value)
+# Generated from XSLoader_pm.PL (resolved %Config::Config value)
+# This file is unique for every OS
 
 package XSLoader;
 
-$VERSION = "0.20";
+$VERSION = "0.28";
 
 #use strict;
 
@@ -92,6 +93,43 @@ print OUT <<'EOT';
     $modlibname =~ s,[\\/][^\\/]+$,, while $c--;    # Q&D basename
 EOT
 
+my $to_print = <<'EOT';
+    # Does this look like a relative path?
+    if ($modlibname !~ m{regexp}) {
+EOT
+
+$to_print =~ s~regexp~
+    $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'amigaos'
+        ? '^(?:[A-Za-z]:)?[\\\/]' # Optional drive letter
+        : '^/'
+~e;
+
+print OUT $to_print, <<'EOT';
+        # Someone may have a #line directive that changes the file name, or
+        # may be calling XSLoader::load from inside a string eval.  We cer-
+        # tainly do not want to go loading some code that is not in @INC,
+        # as it could be untrusted.
+        #
+        # We could just fall back to DynaLoader here, but then the rest of
+        # this function would go untested in the perl core, since all @INC
+        # paths are relative during testing.  That would be a time bomb
+        # waiting to happen, since bugs could be introduced into the code.
+        #
+        # So look through @INC to see if $modlibname is in it.  A rela-
+        # tive $modlibname is not a common occurrence, so this block is
+        # not hot code.
+        FOUND: {
+            for (@INC) {
+                if ($_ eq $modlibname) {
+                    last FOUND;
+                }
+            }
+            # Not found.  Fall back to DynaLoader.
+            goto \&XSLoader::bootstrap_inherit;
+        }
+    }
+EOT
+
 my $dl_dlext = quotemeta($Config::Config{'dlext'});
 
 print OUT <<"EOT";
@@ -105,14 +143,8 @@ 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 \&XSLoader::bootstrap_inherit;
-    }
-
-    goto \&XSLoader::bootstrap_inherit if not -f $file;
+    # This calls DynaLoader::bootstrap, which will load the .bs file if present
+    goto \&XSLoader::bootstrap_inherit if not -f $file or -s $bs;
 
     my $bootname = "boot_$module";
     $bootname =~ s/\W/_/g;
@@ -123,10 +155,11 @@ print OUT <<'EOT';
 EOT
 
     if ($^O eq 'darwin') {
-print OUT <<'EOT';
-        if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) {
-            goto boot; #extension library has already been loaded, e.g. darwin
-        }
+      my $extra_arg = ', 1 ' if $DynaLoader::VERSION ge '1.37';
+print OUT <<"EOT";
+    if (\$boot_symbol_ref = dl_find_symbol( 0, \$bootname $extra_arg)) {
+        goto boot; #extension library has already been loaded, e.g. darwin
+    }
 EOT
     }
 
@@ -144,12 +177,20 @@ print OUT <<'EOT';
     };
     push(@DynaLoader::dl_librefs,$libref);  # record loaded object
 
+EOT
+my $dlsrc = $Config{dlsrc};
+if ($dlsrc eq 'dl_freemint.xs' || $dlsrc eq 'dl_dld.xs') {
+    print OUT <<'EOT';
     my @unresolved = dl_undef_symbols();
     if (@unresolved) {
         require Carp;
         Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
     }
 
+EOT
+}
+
+print OUT <<'EOT';
     $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
         require Carp;
         Carp::croak("Can't find '$bootname' symbol in $file\n");
@@ -208,7 +249,7 @@ XSLoader - Dynamically load C libraries into Perl code
 
 =head1 VERSION
 
-Version 0.17
+Version 0.24
 
 =head1 SYNOPSIS