In perl.git, the branch ap/baseincguard has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/e1271ce08ad90f07bcdc664d64478d77d1cfa997?hp=2d3362edfbf545075aa43a917bfaf4ec7fef9976>

  discards  2d3362edfbf545075aa43a917bfaf4ec7fef9976 (commit)
- Log -----------------------------------------------------------------
commit e1271ce08ad90f07bcdc664d64478d77d1cfa997
Author: Aristotle Pagaltzis <[email protected]>
Date:   Sat Oct 29 09:14:07 2016 +0200

    base: only hide $INC[-1] . from optional loads
-----------------------------------------------------------------------

Summary of changes:
 dist/base/lib/base.pm | 34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm
index 618a25bdaf..9a5bcaedb5 100644
--- a/dist/base/lib/base.pm
+++ b/dist/base/lib/base.pm
@@ -8,7 +8,8 @@ $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::scope_guard::DESTROY { base::__inc::unhook $_[0][0] }
+# instance is blessed array of coderefs to be removed from @INC at scope exit
+sub base::__inc::scope_guard::DESTROY { base::__inc::unhook $_ for @{$_[0]} }
 
 # constant.pm is slow
 sub SUCCESS () { 1 }
@@ -112,21 +113,26 @@ sub import {
                         # So we add a hook to @INC whose job is to hide the 
dot, but which
                         # first checks checks the callstack depth, because 
within nested
                         # require()s the callstack is deeper.
+                        # Since CORE::GLOBAL::require makes it unknowable what 
the exact
+                        # relevant callstack depth will be, we can only record 
it inside
+                        # a hook, so we put another hook at the front of @INC 
where it's
+                        # guaranteed to run.
                         # The way the hook hides the dot is by sitting 
directly in front
-                        # of the dot and removing itself from @INC. This 
causes the dot
-                        # to move up by one index in @INC, which causes the 
for(;;) loop
-                        # inside pp_require() to skip it.
-                        # Relying on this careful positioning is fine because 
the hook is
-                        # only active during the top-level require() where 
@INC is in our
-                        # control. After that the hook is inert, so breaking 
its placement
-                        # has no effect.
+                        # of the dot and removing itself from @INC. This 
causes the dot to
+                        # move up by one index in @INC, causing the for(;;) 
loop inside
+                        # pp_require() to skip it.
+                        # Depending on the specific positions of the hooks in 
@INC is fine
+                        # even though loaded code can destroy that, because 
both hooks are
+                        # only active for the top-level require(), during 
which @INC is in
+                        # our control.
                         # Note that this setup works fine recursively: if a 
module loaded
-                        # via base.pm itself uses base.pm, there will be one 
hook in @INC
-                        # per base::import call frame, but they do not affect 
each other.
-                        my $lvl; 1 while defined caller ++$lvl;
-                        my $hook = sub { ++$dot_hidden, &base::__inc::unhook 
unless defined caller 1+$lvl; () };
-                        $guard = bless [ $hook ], 'base::__inc::scope_guard';
-                        splice @INC, -1, 0, $hook;
+                        # via base.pm itself uses base.pm, there will be one 
pair of hooks
+                        # in @INC per base::import call frame, but they do not 
interfere
+                        # with each other.
+                        my $lvl;
+                        unshift @INC,        sub { unless (defined $lvl) { 1 
while defined caller ++$lvl }; () };
+                        splice  @INC, -1, 0, sub { ++$dot_hidden, 
&base::__inc::unhook unless defined caller $lvl; () };
+                        $guard = bless [ @INC[0,-2] ], 
'base::__inc::scope_guard';
                     }
                     require $fn
                 };

--
Perl5 Master Repository

Reply via email to