Re: [perl #21261] B::Terse not outputting correct constants or variable names

[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / XSLoader_pm.PL

diff --git a/ext/DynaLoader/XSLoader_pm.PL b/ext/DynaLoader/XSLoader_pm.PL
index 8cdfd63..bc7da4a 100644 (file)
--- a/ext/DynaLoader/XSLoader_pm.PL
+++ b/ext/DynaLoader/XSLoader_pm.PL
@@ -37,10 +37,12 @@ print OUT '  my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;
 
 print OUT <<'EOT';
 
-# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
 package DynaLoader;
+
+# 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) &&
-                                !defined(&dl_load_file);
+                                !defined(&dl_error);
 package XSLoader;
 
 1; # End of main code
@@ -90,6 +92,14 @@ print OUT <<'EOT';
     $bootname =~ s/\W/_/g;
     @dl_require_symbols = ($bootname);
 
+    my $boot_symbol_ref;
+
+    if ($^O eq 'darwin') {
+        if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) {
+            goto boot; #extension library has already been loaded, e.g. darwin
+        }
+    }
+
     # Many dynamic extension loading problems will appear to come from
     # this section of code: XYZ failed at line 123 of DynaLoader.pm.
     # Often these errors are actually occurring in the initialisation
@@ -109,15 +119,16 @@ print OUT <<'EOT';
        Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
     }
 
-    my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
+    $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
        require Carp;
        Carp::croak("Can't find '$bootname' symbol in $file\n");
     };
 
-    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
-
     push(@dl_modules, $module); # record loaded module
 
+  boot:
+    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+
     # See comment block above
     return &$xs(@_);