From: Rafael Garcia-Suarez Date: Fri, 30 Sep 2005 08:59:14 +0000 (+0000) Subject: Upgrade to XSLoader 0.05, plus a few doc nits, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=11fd7d057a7e12ce8a195bc4888de10097baa724;p=p5sagit%2Fp5-mst-13.2.git Upgrade to XSLoader 0.05, plus a few doc nits, by Sébastien Aperghis-Tramoni p4raw-id: //depot/perl@25666 --- diff --git a/ext/DynaLoader/XSLoader_pm.PL b/ext/DynaLoader/XSLoader_pm.PL index 231a285..50c588f 100644 --- a/ext/DynaLoader/XSLoader_pm.PL +++ b/ext/DynaLoader/XSLoader_pm.PL @@ -1,3 +1,4 @@ +use strict; use Config; sub to_string { @@ -7,14 +8,16 @@ sub to_string { return "'$value'"; } -unlink "XSLoader.pm" if -f "XSLoader.pm"; +1 while unlink "XSLoader.pm"; open OUT, ">XSLoader.pm" or die $!; print OUT <<'EOT'; # Generated from XSLoader.pm.PL (resolved %Config::Config value) package XSLoader; -$VERSION = "0.03"; +$VERSION = "0.05_01"; + +#use strict; # enable debug/trace messages from DynaLoader perl code # $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; @@ -75,7 +78,7 @@ print OUT <<'EOT'; my $bootname = "boot_$module"; $bootname =~ s/\W/_/g; - @dl_require_symbols = ($bootname); + @DynaLoader::dl_require_symbols = ($bootname); my $boot_symbol_ref; @@ -93,23 +96,23 @@ print OUT <<'EOT'; # it executed. my $libref = dl_load_file($file, 0) or do { - require Carp; - Carp::croak("Can't load '$file' for module $module: " . dl_error()); + require Carp; + Carp::croak("Can't load '$file' for module $module: " . dl_error()); }; - push(@dl_librefs,$libref); # record loaded object + push(@DynaLoader::dl_librefs,$libref); # record loaded object my @unresolved = dl_undef_symbols(); if (@unresolved) { - require Carp; - Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); + require Carp; + Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); } $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { - require Carp; - Carp::croak("Can't find '$bootname' symbol in $file\n"); + require Carp; + Carp::croak("Can't find '$bootname' symbol in $file\n"); }; - push(@dl_modules, $module); # record loaded module + push(@DynaLoader::dl_modules, $module); # record loaded module boot: my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); @@ -119,18 +122,36 @@ print OUT <<'EOT'; return &$xs(@_); retry: + my $bootstrap_inherit = DynaLoader->can('bootstrap_inherit') || + XSLoader->can('bootstrap_inherit'); + goto &$bootstrap_inherit; +} + +# Versions of DynaLoader prior to 5.6.0 don't have this function. +sub bootstrap_inherit { + package DynaLoader; + + my $module = $_[0]; + local *DynaLoader::isa = *{"$module\::ISA"}; + local @DynaLoader::isa = (@DynaLoader::isa, 'DynaLoader'); + # Cannot goto due to delocalization. Will report errors on a wrong line? require DynaLoader; - goto &DynaLoader::bootstrap_inherit; + DynaLoader::bootstrap(@_); } 1; + __END__ =head1 NAME XSLoader - Dynamically load C libraries into Perl code +=head1 VERSION + +Version 0.05_01 + =head1 SYNOPSIS package YourPackage; @@ -145,8 +166,8 @@ linking mechanisms available on many platforms. Its primary purpose is to implement cheap automatic dynamic loading of Perl modules. For a more complicated interface, see L. Many (most) -features of DynaLoader are not implemented in XSLoader, like for -example the dl_load_flags, not honored by XSLoader. +features of C are not implemented in C, like for +example the C, not honored by C. =head2 Migration from C @@ -169,19 +190,19 @@ Change this to XSLoader::load 'YourPackage', $VERSION; In other words: replace C by C, remove -C from @ISA, change C by C. Do not +C from C<@ISA>, change C by C. Do not forget to quote the name of your package on the C line, and add comma (C<,>) before the arguments ($VERSION above). -Of course, if @ISA contained only C, there is no need to have the -@ISA assignment at all; moreover, if instead of C one uses the more -backward-compatible +Of course, if C<@ISA> contained only C, there is no need to have +the C<@ISA> assignment at all; moreover, if instead of C one uses the +more backward-compatible use vars qw($VERSION @ISA); -one can remove this reference to @ISA together with the @ISA assignment. +one can remove this reference to C<@ISA> together with the C<@ISA> assignment. -If no $VERSION was specified on the C line, the last line becomes +If no C<$VERSION> was specified on the C line, the last line becomes XSLoader::load 'YourPackage'; @@ -205,9 +226,9 @@ boilerplate. bootstrap YourPackage $VERSION; }; -The parentheses about XSLoader::load() arguments are needed since we replaced +The parentheses about C arguments are needed since we replaced C by C, so the compiler does not know that a function -XSLoader::load() is present. +C is present. This boilerplate uses the low-overhead C if present; if used with an antic Perl which has no C, it falls back to using C. @@ -225,14 +246,14 @@ in F) and XS code (defined in F). 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 XSLoader::load() (or bootstrap()) has three side effects: +The call to C (or C) has three side effects: =over =item * -if $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; +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 * @@ -249,7 +270,7 @@ convenient to have XSUBs installed before the Perl code is defined; for example, this makes prototypes for XSUBs visible to this Perl code. Alternatively, if the C section makes calls to Perl functions (or uses Perl variables) defined in the F<.pm> file, they must be defined prior to -the call to XSLoader::load() (or bootstrap()). +the call to C (or C). The first situation being much more frequent, it makes sense to rewrite the boilerplate as @@ -274,7 +295,7 @@ boilerplate as If the interdependence of your C section and Perl code is more complicated than this (e.g., the C section makes calls to Perl functions which make calls to XSUBs with prototypes), get rid of the C -section altogether. Replace it with a function onBOOT(), and call it like +section altogether. Replace it with a function C, and call it like this: package YourPackage; @@ -294,24 +315,74 @@ this: # Put Perl initialization code assuming that XS is initialized here + +=head1 DIAGNOSTICS + +=over 4 + +=item Can't find '%s' symbol in %s + +B<(F)> The bootstrap symbol could not be found in the extension module. + +=item Can't load '%s' for module %s: %s + +B<(F)> The loading or initialisation of the extension module failed. +The detailed error follows. + +=item Undefined symbols present after loading %s: %s + +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 XSLoader::load('Your::Module', $Your::Module::VERSION) + +B<(F)> You tried to invoke C 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 is checked to find the extension DLL (this location is where C would put the DLL). If not found, the search for the DLL is transparently -delegated to C, which looks for the DLL along the @INC list. +delegated to C, which looks for the DLL along the C<@INC> list. -In particular, this is applicable to the structure of @INC used for testing +In particular, this is applicable to the structure of C<@INC> used for testing not-yet-installed extensions. This means that running uninstalled extensions may have much more overhead than running the same extensions after C. + +=head1 BUGS + +Please report any bugs or feature requests via the perlbug(1) +utility. + + +=head1 SEE ALSO + +L + + =head1 AUTHOR -Ilya Zakharevich: extraction from DynaLoader. +Ilya Zakharevich originally extracted C from C. + +CPAN version is currently maintained by SEbastien Aperghis-Tramoni +Esebastien@aperghis.netE + +Previous maintainer was Michael G Schwern + + +=head1 COPYRIGHT + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. =cut EOT close OUT or die $!; - diff --git a/ext/DynaLoader/t/XSLoader.t b/ext/DynaLoader/t/XSLoader.t index bd5a52a..4af9a34 100644 --- a/ext/DynaLoader/t/XSLoader.t +++ b/ext/DynaLoader/t/XSLoader.t @@ -1,25 +1,51 @@ -#!./perl -w +#!/usr/bin/perl -wT BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - require Config; import Config; - if ($Config{'extensions'} !~ /\bSDBM_File\b/) { - print "1..0 # Skip: no SDBM_File\n"; - exit 0; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; } } -use Test; -plan tests => 4; +use strict; +use Config; +use Test::More; +my %modules; +BEGIN { + %modules = ( + # ModuleName => q|code to check that it was loaded|, + 'Cwd' => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |, # 5.7 ? + 'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |, # 5.6 + 'SDBM_File' => q| ::is( ref SDBM_File->can('TIEHASH'), 'CODE' ) |, # 5.0 + 'Socket' => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |, # 5.0 + 'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |, # 5.7.3 + ); + plan tests => keys(%modules) * 2 + 3 +} + + +BEGIN { + use_ok( 'XSLoader' ); +} + +# Check functions +can_ok( 'XSLoader' => 'load' ); +#can_ok( 'XSLoader' => 'bootstrap_inherit' ); # doesn't work + +# Check error messages +eval { XSLoader::load() }; +like( $@, '/^XSLoader::load\(\'Your::Module\', \$Your::Module::VERSION\)/', + "calling XSLoader::load() with no argument" ); -use XSLoader; -ok(1); -ok( ref XSLoader->can('load') ); +# Now try to load well known XS modules +my $extensions = $Config{'extensions'}; +$extensions =~ s|/|::|g; -eval { XSLoader::load(); }; -ok( $@ =~ /^XSLoader::load\('Your::Module', \$Your::Module::VERSION\)/ ); +for my $module (sort keys %modules) { + SKIP: { + skip "$module not available", 2 if $extensions !~ /\b$module\b/; + eval qq| package $module; XSLoader::load('$module'); | . $modules{$module}; + is( $@, '', "XSLoader::load($module)"); + } +} -package SDBM_File; -XSLoader::load('SDBM_File'); -::ok( ref SDBM_File->can('TIEHASH') );