try to minimise fallout of base @INC fiddling

(cherry picked from commit 6749a6283459e02074ca1e4c961f390ba5fe0083)

5 files changed, 53 insertions, 4 deletions

diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm
index 1aa814bff9..c919ac1c73 100644
--- a/dist/base/lib/base.pm
+++ b/dist/base/lib/base.pm
@@ -5,6 +5,12 @@ use vars qw($VERSION);
 $VERSION = '2.22_01';
 $VERSION = eval $VERSION;
 
+# 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 }
 
@@ -90,15 +96,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;