diff options
author | Aristotle Pagaltzis <pagaltzis@gmx.de> | 2016-10-11 18:33:59 +0200 |
---|---|---|
committer | Steve Hay <steve.m.hay@googlemail.com> | 2016-10-12 08:20:08 +0100 |
commit | 1ee1950eb0df6c3c2b26f7262094604222ebbdac (patch) | |
tree | a0b5c1c6b2a9445e9fbbbc9cd0e8610b0d94130c | |
parent | 4506b61c8a3e2b8cd5b850c4a6013bfe2b6b281a (diff) | |
download | perl-1ee1950eb0df6c3c2b26f7262094604222ebbdac.tar.gz |
try to minimise fallout of base @INC fiddling
(cherry picked from commit 6749a6283459e02074ca1e4c961f390ba5fe0083)
-rw-r--r-- | dist/base/lib/base.pm | 12 | ||||
-rw-r--r-- | dist/base/t/incdot.t | 2 | ||||
-rw-r--r-- | dist/base/t/incmodified-vs-incdot.t | 27 | ||||
-rw-r--r-- | dist/base/t/lib/BaseIncDoubleExtender.pm | 9 | ||||
-rw-r--r-- | dist/base/t/lib/BaseIncExtender.pm | 7 |
5 files changed, 53 insertions, 4 deletions
diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm index b69f359076..d7193a6c8a 100644 --- a/dist/base/lib/base.pm +++ b/dist/base/lib/base.pm @@ -6,6 +6,12 @@ use vars qw($VERSION); $VERSION = '2.23_01'; $VERSION =~ tr/_//d; +# simplest way to avoid indexing of the package: no package statement +sub base::__inc_scope_guard::DESTROY { + my $noop = $_[0][0]; + ref $_ and $_ == $noop and $_ = '.' for @INC; +} + # constant.pm is slow sub SUCCESS () { 1 } @@ -91,15 +97,15 @@ sub import { next if grep $_->isa($base), ($inheritor, @bases); - # Following blocks help isolate $SIG{__DIE__} changes + # Following blocks help isolate $SIG{__DIE__} and @INC changes { my $sigdie; { local $SIG{__DIE__}; my $fn = _module_to_filename($base); - local @INC = @INC; - pop @INC if my $dotty = $INC[-1] eq '.'; + my $dotty = $INC[-1] eq '.' && ( $INC[-1] = sub {()} ); eval { + my $redotty = $dotty && bless [ $dotty ], 'base::__inc_scope_guard'; require $fn }; # Only ignore "Can't locate" errors from our eval require. diff --git a/dist/base/t/incdot.t b/dist/base/t/incdot.t index 1619492250..e0619a6d4c 100644 --- a/dist/base/t/incdot.t +++ b/dist/base/t/incdot.t @@ -8,7 +8,7 @@ use Test::More tests => 2; if ($INC[-1] ne '.') { push @INC, '.' } -my $inc = quotemeta "@INC[0..$#INC-1]"; +my $inc = quotemeta "@INC"; eval { 'base'->import("foo") }; like $@, qr/\@INC contains: $inc\).\)/, diff --git a/dist/base/t/incmodified-vs-incdot.t b/dist/base/t/incmodified-vs-incdot.t new file mode 100644 index 0000000000..a5288e861f --- /dev/null +++ b/dist/base/t/incmodified-vs-incdot.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More tests => 10; # one test is in each BaseInc* itself + +use lib 't/lib'; + +# make it look like an older perl +BEGIN { push @INC, '.' if $INC[-1] ne '.' } + +use base 'BaseIncExtender'; + +BEGIN { + is $INC[0], 't/lib/blahblah', 'modules loaded by base can prepend entries to @INC'; + is $INC[1], 't/lib', 'previously prepended additional @INC entry remains'; + is $INC[-1], '.', 'dot still at end @INC after using base'; +} + +use base 'BaseIncDoubleExtender'; + +BEGIN { + is $INC[0], 't/lib/blahdeblah', 'modules loaded by base can prepend entries to @INC'; + is $INC[1], 't/lib/blahblah', 'previously prepended additional @INC entry remains'; + is $INC[2], 't/lib', 'previously prepended additional @INC entry remains'; + is $INC[-2], '.', 'dot still at previous end of @INC after using base'; + is $INC[-1], 't/lib/on-end', 'modules loaded by base can append entries to @INC'; +} diff --git a/dist/base/t/lib/BaseIncDoubleExtender.pm b/dist/base/t/lib/BaseIncDoubleExtender.pm new file mode 100644 index 0000000000..455c5de513 --- /dev/null +++ b/dist/base/t/lib/BaseIncDoubleExtender.pm @@ -0,0 +1,9 @@ +package BaseIncDoubleExtender; + +BEGIN { ::ok( $INC[-1] ne '.', 'no trailing dot in @INC during module load from base' ) } + +use lib 't/lib/blahdeblah'; + +push @INC, 't/lib/on-end'; + +1; diff --git a/dist/base/t/lib/BaseIncExtender.pm b/dist/base/t/lib/BaseIncExtender.pm new file mode 100644 index 0000000000..3b693adc06 --- /dev/null +++ b/dist/base/t/lib/BaseIncExtender.pm @@ -0,0 +1,7 @@ +package BaseIncExtender; + +BEGIN { ::ok( $INC[-1] ne '.', 'no trailing dot in @INC during module load from base' ) } + +use lib 't/lib/blahblah'; + +1; |