Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Provide strict compliance for DynaLoader and XSLoader #18662

Closed
wants to merge 6 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
8 changes: 3 additions & 5 deletions dist/XSLoader/Makefile.PL
Expand Up @@ -8,6 +8,8 @@
use strict;
use warnings;

use v5.6;

use ExtUtils::MakeMaker;
use ExtUtils::MM_Unix;

Expand Down Expand Up @@ -101,11 +103,7 @@ WriteMakefile(
my @perls = ($orig_perl);
push @perls, qw(bleadperl
perl5.6.1
perl5.6.0
perl5.005_03
perl5.004_05
perl5.004_04
perl5.004)
perl5.6.0)
if $ENV{PERL_TEST_ALL};

my $out;
Expand Down
59 changes: 7 additions & 52 deletions dist/XSLoader/XSLoader_pm.PL
@@ -1,4 +1,6 @@
use strict;
use warnings;

use Config;
# We require DynaLoader to make sure that mod2fname is loaded
eval { require DynaLoader };
Expand All @@ -9,37 +11,15 @@ print OUT <<'EOT';
# Generated from XSLoader_pm.PL (resolved %Config::Config value)
# This file is unique for every OS

package XSLoader;
use strict;
no strict 'refs';

$VERSION = "0.30"; # remember to update version in POD!
package XSLoader;

#use strict;
our $VERSION = "0.31"; # remember to update version in POD!

package DynaLoader;

EOT

# dlutils.c before 5.006 has this:
#
# #ifdef DEBUGGING
# dl_debug = SvIV( perl_get_sv("DynaLoader::dl_debug", 0x04) );
# #endif
#
# where 0x04 is GV_ADDWARN, which causes a warning to be issued by the call
# into XS below, if DynaLoader.pm hasn't been loaded.
# It was changed to 0 in the commit(s) that added XSLoader to the core
# (9cf41c4d23a47c8b and its parent 9426adcd48655815)
# Hence to backport XSLoader to work silently with earlier DynaLoaders we need
# to ensure that the variable exists:

print OUT <<'EOT' if $] < 5.006;

# enable debug/trace messages from DynaLoader perl code
$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;

EOT

print OUT <<'EOT';
# 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) &&
Expand Down Expand Up @@ -208,42 +188,17 @@ print OUT <<'EOT';
push(@DynaLoader::dl_shared_objects, $file); # record files loaded
return &$xs(@_);
}
EOT

# Can't test with DynaLoader->can('bootstrap_inherit') when building in the
# core, as XSLoader gets built before DynaLoader.

if ($] >= 5.006) {
print OUT <<'EOT';

sub bootstrap_inherit {
require DynaLoader;
goto \&DynaLoader::bootstrap_inherit;
}

EOT
} else {
print OUT <<'EOT';

sub bootstrap_inherit {
# Versions of DynaLoader prior to 5.6.0 don't have 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;
DynaLoader::bootstrap(@_);
}

EOT
}

print OUT <<'EOT';
1;


__END__

=head1 NAME
Expand All @@ -252,7 +207,7 @@ XSLoader - Dynamically load C libraries into Perl code

=head1 VERSION

Version 0.30
Version 0.31

=head1 SYNOPSIS

Expand Down
6 changes: 4 additions & 2 deletions dist/XSLoader/t/XSLoader.t
@@ -1,6 +1,8 @@
#!perl -T

use strict;
use warnings;
tonycoz marked this conversation as resolved.
Show resolved Hide resolved

use Config;

my $db_file;
Expand All @@ -10,8 +12,6 @@ BEGIN {
die "Test::More not available\n";
}

plan(skip_all => "these tests needs Perl 5.5+") if $] < 5.005;

use Config;
foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) {
if ($Config{extensions} =~ /\b$_\b/) {
Expand Down Expand Up @@ -117,6 +117,7 @@ SKIP: {

# [perl #122455]
# die instead of falling back to DynaLoader
no warnings 'redefine';
local *XSLoader::bootstrap_inherit = sub { die "Fallback to DynaLoader\n" };
::ok( eval <<EOS, "test correct path searched for modules")
package Not::Devel::Peek;
Expand All @@ -135,6 +136,7 @@ SKIP: {
">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}";
close $fh;
my $fell_back;
no warnings 'redefine';
local *XSLoader::bootstrap_inherit = sub {
$fell_back++;
# Break out of the calling subs
Expand Down
16 changes: 14 additions & 2 deletions ext/DynaLoader/DynaLoader_pm.PL
Expand Up @@ -73,6 +73,8 @@ print OUT <<'EOT';

# Generated from DynaLoader_pm.PL, this file is unique for every OS

use strict;

package DynaLoader;

# And Gandalf said: 'Many folk like to know beforehand what is to
Expand All @@ -88,9 +90,17 @@ package DynaLoader;
# Tim.Bunce@ig.co.uk, August 1994

BEGIN {
$VERSION = '1.50';
our $VERSION = '1.51';
}

# Note: in almost any other piece of code "our" would have been a better
# option than "use vars", but DynaLoader's bootstrap files need the
# side effect of the variable being declared in any scope whose current
# package is DynaLoader, not just the current lexical one.
use vars qw(@dl_library_path @dl_resolve_using @dl_require_symbols
$dl_debug @dl_librefs @dl_modules @dl_shared_objects
$dl_dlext $dl_so $dlsrc @args $module @dirs $file $bscode);

EOT

if (!$ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {
Expand Down Expand Up @@ -141,7 +151,7 @@ print OUT expand_os_specific(<<'EOT');
# inefficient to define on systems that don't need it.
$Is_VMS = $^O eq 'VMS';
<</$^O-eq-VMS>>
$do_expand = <<$^O-eq-VMS>>1<<|$^O-eq-VMS>>0<</$^O-eq-VMS>>;
my $do_expand = <<$^O-eq-VMS>>1<<|$^O-eq-VMS>>0<</$^O-eq-VMS>>;

@dl_require_symbols = (); # names of symbols we need<<$^O-eq-freemint>>
@dl_resolve_using = (); # names of files to link with<</$^O-eq-freemint>><<$^O-eq-hpux>>
Expand Down Expand Up @@ -292,6 +302,8 @@ sub croak { require Carp; Carp::croak(@_) }

sub bootstrap_inherit {
my $module = $_[0];

no strict qw/refs vars/;
local *isa = *{"$module\::ISA"};
local @isa = (@isa, 'DynaLoader');
# Cannot goto due to delocalization. Will report errors on a wrong line?
Expand Down
2 changes: 2 additions & 0 deletions ext/DynaLoader/Makefile.PL
@@ -1,4 +1,6 @@
use strict;
use warnings;

use ExtUtils::MakeMaker;

my $is_mswin = $^O eq 'MSWin32';
Expand Down
2 changes: 2 additions & 0 deletions ext/DynaLoader/t/DynaLoader.t
@@ -1,6 +1,8 @@
#!/usr/bin/perl -wT

use strict;
use warnings;

use Config;
push @INC, '.';
if (-f 't/test.pl') {
Expand Down