diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm index 38c91c731c58..a1878840bfe8 100644 --- a/dist/base/lib/base.pm +++ b/dist/base/lib/base.pm @@ -6,6 +6,13 @@ use vars qw($VERSION); $VERSION = '2.24'; $VERSION =~ tr/_//d; +{ + package # + base::__scope_guard; + + sub DESTROY { $_[0]->[0]->() } +} + # constant.pm is slow sub SUCCESS () { 1 } @@ -91,14 +98,22 @@ 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; + my ($sigdie, $redotty_scopeguard); { local $SIG{__DIE__}; my $fn = _module_to_filename($base); - local @INC = @INC; - pop @INC if my $dotty = $INC[-1] eq '.'; + + if ($INC[-1] eq '.') { + pop @INC; + my $localized_tail = $INC[-1]; + $redotty_scopeguard = bless([ sub { + push @INC, '.' + if $localized_tail eq $INC[-1]||''; + } ], 'base::__scope_guard'); + } + eval { require $fn }; @@ -120,7 +135,7 @@ Base class package "$base" is empty. (Perhaps you need to 'use' the module which defines that package first, or make that module available in \@INC (\@INC contains: @INC). ERROR - if ($dotty && -e $fn) { + if ($redotty_scopeguard && -e $fn) { $e .= < 10; # one test is in each BaseInc* itself + +use lib qw(t/lib); + +# make it look like an older perl +BEGIN { + push @INC, '.' + if $INC[-1] ne '.'; +} + +use base 'BaseIncExtender'; + +BEGIN { + is $INC[0], 't/libleblab', 'Expected head @INC adjustment from within `use base`'; + is $INC[1], 't/lib', 'Preexisting @INC adjustment still in @INC'; + is $INC[-1], '.', 'Trailing . still in @INC ater `use base`'; +} + +use base 'BaseIncDoubleExtender'; + +BEGIN { + is $INC[0], 't/libloblub', 'Expected head @INC adjustment from within `use base`'; + is $INC[1], 't/libleblab', 'Preexisting @INC adjustment still in @INC'; + is $INC[2], 't/lib', 'Preexisting @INC adjustment still in @INC'; + cmp_ok $INC[-2], 'ne', '.', 'Trailing . not reinserted erroneously'; + is $INC[-1], 't/libonend', 'Expected tail @INC adjustment from within `use base`'; +} diff --git a/dist/base/t/lib/BaseIncDoubleExtender.pm b/dist/base/t/lib/BaseIncDoubleExtender.pm new file mode 100644 index 000000000000..db210aba1ebe --- /dev/null +++ b/dist/base/t/lib/BaseIncDoubleExtender.pm @@ -0,0 +1,14 @@ +package BaseIncDoubleExtender; + +BEGIN { + ::ok( + ( $INC[-1] ne '.' ), + '. not at @INCs tail during `use base ...`', + ); +} + +use lib 't/libloblub'; + +push @INC, 't/libonend'; + +1; diff --git a/dist/base/t/lib/BaseIncExtender.pm b/dist/base/t/lib/BaseIncExtender.pm new file mode 100644 index 000000000000..1bd2927c2ddb --- /dev/null +++ b/dist/base/t/lib/BaseIncExtender.pm @@ -0,0 +1,12 @@ +package BaseIncExtender; + +BEGIN { + ::ok( + ( $INC[-1] ne '.' ), + '. not at @INCs tail during `use base ...`', + ); +} + +use lib 't/libleblab'; + +1;