In perl.git, the branch ap/baseincguard has been updated <http://perl5.git.perl.org/perl.git/commitdiff/bcafe078ba2cf05417851462cd4506e758839b29?hp=4ac8c2985429842eb5c460d41549a144cee4af74>
discards 4ac8c2985429842eb5c460d41549a144cee4af74 (commit) discards 5dcc8aa65bd983e00492472fc5a2f3c606e72bb0 (commit) - Log ----------------------------------------------------------------- commit bcafe078ba2cf05417851462cd4506e758839b29 Author: Aristotle Pagaltzis <[email protected]> Date: Sat Oct 29 04:10:43 2016 +0200 base: only hide $INC[-1] . from optional loads ----------------------------------------------------------------------- Summary of changes: dist/base/lib/base.pm | 9 +++++---- dist/base/t/incdot.t | 8 ++++---- dist/base/t/lib/BaseIncChecker.pm | 5 ++++- dist/base/t/lib/BaseIncDoubleExtender.pm | 5 ++++- dist/base/t/lib/BaseIncExtender.pm | 5 ++++- 5 files changed, 21 insertions(+), 11 deletions(-) diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm index 7faabea..163b41b 100644 --- a/dist/base/lib/base.pm +++ b/dist/base/lib/base.pm @@ -7,7 +7,7 @@ $VERSION = '2.24'; $VERSION =~ tr/_//d; # simplest way to avoid indexing of the package: no package statement -sub base::__inc::unhook { @INC = grep !(ref $_ eq 'CODE' && $_ == $_[0]), @INC } +sub base::__inc::unhook { @INC = grep !(ref eq 'CODE' && $_ == $_[0]), @INC } sub base::__inc::scope_guard::DESTROY { base::__inc::unhook $_ for @{$_[0]} } # constant.pm is slow @@ -103,7 +103,7 @@ sub import { my $fn = _module_to_filename($base); my $dot_hidden; eval { - my $inc_guard; + my $guard; if ($INC[-1] eq '.' && %{"$base\::"}) { # So: the package already exists => this an optional load # And: there is a . at the end of @INC => we want to hide it @@ -112,7 +112,8 @@ sub import { # To achieve this overal effect, we use two hooks: # - The rear hook is placed just before the . and serves # to hide it just before @INC traversal would reach it, - # by removing itself from @INC, causing the . to be skipped. + # which it does by removing itself from @INC and thereby + # moving the . up by one index, causing it to be skipped. # - The front hook is placed at the front of @INC and serves # to remove the rear hook if itâs ever reached twice. # During the initial @INC traversal (by our own `require`) @@ -120,7 +121,7 @@ sub import { my ($reentrant, $front_hook, $rear_hook); unshift @INC, $front_hook = sub { base::__inc::unhook $rear_hook if $reentrant++; () }; splice @INC, -1, 0, $rear_hook = sub { ++$dot_hidden, &base::__inc::unhook; () }; - $inc_guard = bless [ $front_hook, $rear_hook ], 'base::__inc::scope_guard'; + $guard = bless [ $front_hook, $rear_hook ], 'base::__inc::scope_guard'; } require $fn }; diff --git a/dist/base/t/incdot.t b/dist/base/t/incdot.t index cdd5000..df98f72 100644 --- a/dist/base/t/incdot.t +++ b/dist/base/t/incdot.t @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 8; # one test is in each BaseInc* itself +use Test::More tests => 11; # two extra tests in each BaseInc*.pm sub rendered_comparison { my ( $got, $expected ) = @_; @@ -10,8 +10,7 @@ sub rendered_comparison { join "\n", map +( "got [$_] " . $got->[$_], 'expected'.(' ' x length).$expected->[$_] ), 0 .. $#$got; } -my $hook; -use lib 't/lib', $hook = sub {()}; +use lib 't/lib', sub {()}; # make it look like an older perl BEGIN { push @INC, '.' if $INC[-1] ne '.' } @@ -26,10 +25,11 @@ BEGIN { ok !$success, 'loading optional modules from . fails'; is_deeply \@INC, \@expected, '... without changes to @INC' or diag rendered_comparison [@INC], [@expected]; - like $@, qr!Base class package "t::lib::Dummy" is not empty but "t/lib/Dummy\.pm" exists in the current directory\.!, + like $err, qr!Base class package "t::lib::Dummy" is not empty but "t/lib/Dummy\.pm" exists in the current directory\.!, '... and the proper error message'; } +BEGIN { @BaseIncExtender::ISA = () } # make it look like an optional load use base 'BaseIncExtender'; BEGIN { diff --git a/dist/base/t/lib/BaseIncChecker.pm b/dist/base/t/lib/BaseIncChecker.pm index 2cbbbcc..ff557fd 100644 --- a/dist/base/t/lib/BaseIncChecker.pm +++ b/dist/base/t/lib/BaseIncChecker.pm @@ -1,5 +1,8 @@ package BaseIncChecker; -BEGIN { ::ok( $INC[-1] eq '.', 'trailing dot remains in @INC during mandatory module load from base' ) } +BEGIN { + ::is $INC[-1], '.', 'trailing dot remains in @INC during mandatory module load from base'; + ::is 0+(grep ref eq 'CODE', @INC), 1, '... and no extra hook is present'; +} 1; diff --git a/dist/base/t/lib/BaseIncDoubleExtender.pm b/dist/base/t/lib/BaseIncDoubleExtender.pm index b28d75b..3ccdf22 100644 --- a/dist/base/t/lib/BaseIncDoubleExtender.pm +++ b/dist/base/t/lib/BaseIncDoubleExtender.pm @@ -1,6 +1,9 @@ package BaseIncDoubleExtender; -BEGIN { ::ok( $INC[-1] eq '.', 'trailing dot remains in @INC during optional module load from base' ) } +BEGIN { + ::is $INC[-1], '.', 'trailing dot remains in @INC during optional module load from base'; + ::is 0+(grep ref eq 'CODE', @INC), 3, '... but the expected extra hooks'; +} use lib 't/lib/blahdeblah'; diff --git a/dist/base/t/lib/BaseIncExtender.pm b/dist/base/t/lib/BaseIncExtender.pm index 8d89d13..87df194 100644 --- a/dist/base/t/lib/BaseIncExtender.pm +++ b/dist/base/t/lib/BaseIncExtender.pm @@ -1,6 +1,9 @@ package BaseIncExtender; -BEGIN { ::ok( $INC[-1] eq '.', 'trailing dot remains in @INC during optional module load from base' ) } +BEGIN { + ::is $INC[-1], '.', 'trailing dot remains in @INC during optional module load from base'; + ::is 0+(grep ref eq 'CODE', @INC), 3, '... but the expected extra hooks'; +} use lib 't/lib/blahblah'; -- Perl5 Master Repository
