From: Vadim Konovalov Date: Sun, 3 Oct 2004 22:10:06 +0000 (+0400) Subject: dynaloader improvements and cleanup X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1c7f9087b1206cc798470bc670fc38b5c413712a;p=p5sagit%2Fp5-mst-13.2.git dynaloader improvements and cleanup Message-ID: <138-1837306906.20041003221006@vkonovalov.ru> p4raw-id: //depot/perl@23348 --- diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index aff74a4..85d2bd3 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -7,6 +7,59 @@ sub to_string { return "'$value'"; } +# +# subroutine expand_os_specific expands $^O-specific preprocessing information +# so that it will not be re-calculated at runtime in Dynaloader.pm +# +# Syntax of preprocessor should be kept extremely simple: +# - directives are in double angle brackets <<...>> +# - <<=string>> will be just evaluated +# - for $^O-specific there are two forms: +# <<$^O-eq-osname>> +# <<$^O-ne-osname>> +# this directive should be closed with respectively +# <> +# <> +# construct <<|$^O-ne-osname>> means #else +# nested <<$^O...>>-constructs are allowed but nested values must be for +# different OS-names! +# +# -- added by VKON, 03-10-2004 to separate $^O-specific between OSes +# (so that Win32 never checks for $^O eq 'VMS' for example) +sub expand_os_specific { + my $s = shift; + for ($s) { + s/<<=(.*?)>>/$1/gee; + s/<<\$\^O-(eq|ne)-(\w+)>>(.*?)<<\/\$\^O-\1-\2>>/ + my ($op, $os, $expr) = ($1,$2,$3); + if ($op ne 'eq' and $op ne 'ne') {die "wrong eq-ne arg in $&"}; + if ($expr =~ m[^(.*?)<<\|\$\^O-$op-$os>>(.*?)$]s) { + # #if;#else;#endif + my ($if,$el) = ($1,$2); + if (($op eq 'eq' and $^O eq $os) || ($op eq 'ne' and $^O ne $os)) { + $if + } + else { + $el + } + } + else { + # #if;#endif + if (($op eq 'eq' and $^O eq $os) || ($op eq 'ne' and $^O ne $os)) { + $expr + } + else { + "" + } + } + /ges; + if (/<<(=|\$\^O-)/) {die "bad <<\$^O-eq/ne-osname>> expression.". + " Unclosed brackets?"; + } + } + $s; +} + unlink "DynaLoader.pm" if -f "DynaLoader.pm"; open OUT, ">DynaLoader.pm" or die $!; print OUT <<'EOT'; @@ -29,7 +82,7 @@ package DynaLoader; use vars qw($VERSION *AUTOLOAD); -$VERSION = '1.05'; # avoid typo warning +$VERSION = '1.06'; require AutoLoader; *AUTOLOAD = \&AutoLoader::AUTOLOAD; @@ -63,22 +116,26 @@ sub dl_load_flags { 0x00 } # = @Config::Config{'dlext', 'dlsrc'}; EOT -print OUT " (\$dl_dlext, \$dlsrc) = (", - to_string($Config::Config{'dlext'}), ",", - to_string($Config::Config{'dlsrc'}), ")\n;" ; +$dl_dlext = $Config::Config{'dlext'}; +$dl_so = $Config::Config{'so'}; +print OUT " (\$dl_dlext, \$dlsrc) = ('$dl_dlext', ", + to_string($Config::Config{'dlsrc'}), ")\n;"; -print OUT <<'EOT'; +print OUT expand_os_specific(<<'EOT'); +<<$^O-eq-VMS>> # Some systems need special handling to expand file specifications # (VMS support by Charles Bailey ) # See dl_expandspec() for more details. Should be harmless but # inefficient to define on systems that don't need it. $Is_VMS = $^O eq 'VMS'; -$do_expand = $Is_VMS; -$Is_MacOS = $^O eq 'MacOS'; +<> +$do_expand = <<$^O-eq-VMS>>1<<|$^O-eq-VMS>>0<>; +<<$^O-eq-MacOS>> my $Mac_FS; -$Mac_FS = eval { require Mac::FileSpec::Unixish } if $Is_MacOS; +$Mac_FS = eval { require Mac::FileSpec::Unixish }; +<> @dl_require_symbols = (); # names of symbols we need @dl_resolve_using = (); # names of files to link with @@ -99,7 +156,7 @@ push(@dl_library_path, split(' ', $Config::Config{libpth})); EOT sub dquoted_comma_list { - join(", ", map {qq("$_")} @_); + join(", ", map {'"'.quotemeta($_).'"'} @_); } if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { @@ -129,21 +186,21 @@ my $ldlibpthname_defined; my $pthsep; if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { - $ldlibpthname = $Config::Config{ldlibpthname}; - $ldlibpthname_defined = defined $Config::Config{ldlibpthname} ? 1 : 0; - $pthsep = $Config::Config{path_sep}; + $ldlibpthname = to_string($Config::Config{ldlibpthname}); + $ldlibpthname_defined = to_string(defined $Config::Config{ldlibpthname} ? 1 : 0); + $pthsep = to_string($Config::Config{path_sep}); } else { $ldlibpthname = q($Config::Config{ldlibpthname}); $ldlibpthname_defined = q(defined $Config::Config{ldlibpthname}); $pthsep = q($Config::Config{path_sep}); - print OUT <> # Can dynaload, but cannot dynaload Perl modules... die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static; -EOT - -print OUT <<'EOT'; + <> my @modparts = split(/::/,$module); my $modfname = $modparts[-1]; @@ -247,38 +303,40 @@ print OUT <<'EOT'; # It may also edit @modparts if required. $modfname = &mod2fname(\@modparts) if defined &mod2fname; + <<$^O-eq-NetWare>> # Truncate the module name to 8.3 format for NetWare - if (($^O eq 'NetWare') && (length($modfname) > 8)) { + if ((length($modfname) > 8)) { $modfname = substr($modfname, 0, 8); } + <> - my $modpname = join(($Is_MacOS ? ':' : '/'),@modparts); + my $modpname = join(<<$^O-eq-MacOS>>':'<<|$^O-eq-MacOS>>'/'<>,@modparts); print STDERR "DynaLoader::bootstrap for $module ", - ($Is_MacOS - ? "(:auto:$modpname:$modfname.$dl_dlext)\n" : - "(auto/$modpname/$modfname.$dl_dlext)\n") + <<$^O-eq-MacOS>> "(:auto:$modpname:$modfname.<<=$dl_dlext>>)\n" + <<|$^O-eq-MacOS>>"(auto/$modpname/$modfname.<<=$dl_dlext>>)\n"<> if $dl_debug; foreach (@INC) { - chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS; - my $dir; - if ($Is_MacOS) { + <<$^O-eq-VMS>>chop($_ = VMS::Filespec::unixpath($_));<> + <<$^O-eq-MacOS>> my $path = $_; if ($Mac_FS && ! -d $path) { $path = Mac::FileSpec::Unixish::nativize($path); } $path .= ":" unless /:$/; - $dir = "${path}auto:$modpname"; - } else { - $dir = "$_/auto/$modpname"; - } + my $dir = "${path}auto:$modpname"; + <<|$^O-eq-MacOS>> + my $dir = "$_/auto/$modpname"; + <> next unless -d $dir; # skip over uninteresting directories # check for common cases to avoid autoload of dl_findfile - my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext"; - last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try); + my $try = <<$^O-eq-MacOS>> "$dir:$modfname.<<=$dl_dlext>>" <<|$^O-eq-MacOS>> "$dir/$modfname.<<=$dl_dlext>>"<>; + last if $file = <<$^O-eq-VMS>>($do_expand) ? dl_expandspec($try) : ((-f $try) && $try); + <<|$^O-eq-VMS>>(-f $try) && $try; + <> # no luck here, save dir for possible later dl_findfile search push @dirs, $dir; @@ -289,7 +347,7 @@ print OUT <<'EOT'; croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)") unless $file; # wording similar to error from 'require' - $file = uc($file) if $Is_VMS && $Config::Config{d_vms_case_sensitive_symbols}; + <<$^O-eq-VMS>>$file = uc($file) if $Config::Config{d_vms_case_sensitive_symbols};<> my $bootname = "boot_$module"; $bootname =~ s/\W/_/g; @dl_require_symbols = ($bootname); @@ -307,11 +365,11 @@ print OUT <<'EOT'; 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 - } + <<$^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. @@ -366,42 +424,40 @@ sub dl_findfile { my (@args) = @_; my (@dirs, $dir); # which directories to search my (@found); # full paths to real files we have found -EOT - -print OUT ' my $dl_ext= ' . to_string($Config::Config{'dlext'}) . - "; # \$Config::Config{'dlext'} suffix for perl extensions\n"; -print OUT ' my $dl_so = ' . to_string($Config::Config{'so'}) . - "; # \$Config::Config{'so'} suffix for shared libraries\n"; - -print OUT <<'EOT'; + #my $dl_ext= <<=to_string($Config::Config{'dlext'})>>; # $Config::Config{'dlext'} suffix for perl extensions + #my $dl_so = <<=to_string($Config::Config{'so'})>>; # $Config::Config{'so'} suffix for shared libraries print STDERR "dl_findfile(@args)\n" if $dl_debug; # accumulate directories but process files as they appear arg: foreach(@args) { # Special fast case: full filepath requires no search - if ($Is_VMS && m%[:>/\]]% && -f $_) { + <<$^O-eq-VMS>> + if (m%[:>/\]]% && -f $_) { push(@found,dl_expandspec(VMS::Filespec::vmsify($_))); last arg unless wantarray; next; } - elsif ($Is_MacOS) { + <> + <<$^O-eq-MacOS>> if (m/:/ && -f $_) { push(@found,$_); last arg unless wantarray; } - } - elsif (m:/: && -f $_ && !$do_expand) { + <> + <<$^O-ne-VMS>> + if (m:/: && -f $_) { push(@found,$_); last arg unless wantarray; next; } + <> # Deal with directories first: # Using a -L prefix is the preferred option (faster and more robust) if (m:^-L:) { s/^-L//; push(@dirs, $_); next; } - if ($Is_MacOS) { + <<$^O-eq-MacOS>> # Otherwise we try to try to spot directories by a heuristic # (this is a more complicated issue than it first appears) if (m/:/ && -d $_) { push(@dirs, $_); next; } @@ -423,33 +479,37 @@ print OUT <<'EOT'; } } next; - } + <> # Otherwise we try to try to spot directories by a heuristic # (this is a more complicated issue than it first appears) if (m:/: && -d $_) { push(@dirs, $_); next; } + <<$^O-eq-VMS>> # VMS: we may be using native VMS directory syntax instead of # Unix emulation, so check this as well - if ($Is_VMS && /[:>\]]/ && -d $_) { push(@dirs, $_); next; } + if (/[:>\]]/ && -d $_) { push(@dirs, $_); next; } + <> # Only files should get this far... my(@names, $name); # what filenames to look for if (m:-l: ) { # convert -lname to appropriate library name s/-l//; - push(@names,"lib$_.$dl_so"); + push(@names,"lib$_.<<=to_string($Config::Config{'so'})>>"); push(@names,"lib$_.a"); } else { # Umm, a bare name. Try various alternatives: # these should be ordered with the most likely first - push(@names,"$_.$dl_ext") unless m/\.$dl_ext$/o; - push(@names,"$_.$dl_so") unless m/\.$dl_so$/o; - push(@names,"lib$_.$dl_so") unless m:/:; + push(@names,"$_.<<=$dl_dlext>>") unless m/\.<<=$dl_dlext>>$/o; + push(@names,"$_.<<=$dl_so>>") unless m/\.<<=$dl_so>>$/o; + push(@names,"lib$_.<<=$dl_so>>") unless m:/:; push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs"; push(@names, $_); } foreach $dir (@dirs, @dl_library_path) { next unless -d $dir; - chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS; + <<$^O-eq-VMS>> + chop($dir = VMS::Filespec::unixpath($dir)); + <> foreach $name (@names) { my($file) = "$dir/$name"; print STDERR " checking in $dir for $name\n" if $dl_debug; @@ -489,12 +549,13 @@ sub dl_expandspec { my $file = $spec; # default output to input - if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs + <<$^O-eq-VMS>> + # dl_expandspec should be defined in dl_vms.xs require Carp; Carp::croak("dl_expandspec: should be defined in XS file!\n"); - } else { + <<|$^O-eq-VMS>> return undef unless -f $file; - } + <> print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug; $file; }