pp_ctl.c - copy hook into %INC not alias it

When an @inc hook is executed and it updates %INC it can result in @inc
being updated and the hook being destroyed.

This seems to be because the SV fetched from @inc is stored into %INC
directly, essentially creating an alias (in perl terms) of the original.
When the alias is updated, for instance by setting it to be a string,
this is reflected in both @inc and %INC.

By copying the sv before we store it we avoid this problem.

We can't run the test under miniperl as it uses IO layers.

This should fix GH #20577.

Author: demerphq

MANIFEST

@@ -5972,6 +5972,7 @@ t/op/ref.t			See if refs and objects work
 t/op/repeat.t			See if x operator works
 t/op/require_37033.t		See if require always closes rsfp
 t/op/require_errors.t		See if errors from require are reported correctly
+t/op/require_gh20577.t		Make sure updating %INC from an INC hook doesnt break @INC
 t/op/require_override.t		See if require handles no argument properly
 t/op/reset.t			See if reset operator works
 t/op/reverse.t			See if reverse operator works

pp_ctl.c

@@ -4605,10 +4605,13 @@ S_require_file(pTHX_ SV *sv)
         (void)hv_store(GvHVn(PL_incgv),
                        unixname, unixlen, newSVpv(tryname,0),0);
     } else {
+        /* store the hook in the sv, note we have to *copy* hook_sv,
+         * we don't want modifications to it to change @INC - see GH #20577
+         */
         SV** const svp = hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
         if (!svp)
             (void)hv_store(GvHVn(PL_incgv),
-                           unixname, unixlen, SvREFCNT_inc_simple(hook_sv), 0 );
+                           unixname, unixlen, newSVsv(hook_sv), 0 );
     }
 
     /* Now parse the file */

t/op/require_gh20577.t

@@ -0,0 +1,58 @@
+#!perl -w
+
+# Check that modifying %INC during an @INC hook does not
+# clobber the hook by modifying @INC at the same time.
+# See GitHub Issue #20577
+
+chdir "t" if -d "t";
+require './test.pl';
+skip_all_if_miniperl("as PerlIO layer 'scalar' not supported under miniperl");
+set_up_inc( '../lib' );
+eval <<'EOF' or die $@;
+{
+    my %fatpacked;
+
+    $fatpacked{"Test1.pm"} = <<'TEST1';
+  package Test1;
+  sub import {
+      my $filename = 'Test2.pm';
+      $INC{$filename} = "the_test_file";
+  }
+  1;
+TEST1
+
+    $fatpacked{"Test2.pm"} = <<'TEST2';
+  package Test2;
+  use Test1;
+  1;
+TEST2
+
+    my $class = 'FatPacked';
+    no strict 'refs';
+
+    *{"${class}::INC"} = sub {
+        if ( my $fat = $_[0]{ $_[1] } ) {
+            open my $fh, '<', \$fat
+              or die;
+            return $fh;
+        }
+        return;
+    };
+
+    unshift @INC, bless \%fatpacked, $class;
+}
+1
+EOF
+
+ok(UNIVERSAL::isa($INC[0],"FatPacked"), '$INC[0] starts FatPacked');
+ok(!exists $INC{"Test1.pm"}, 'Test1.pm not in %INC');
+ok(!exists $INC{"Test2.pm"}, 'Test2.pm not in %INC');
+my $ok= eval "use Test2; 1";
+my $err= !$ok ? $@ : undef;
+is($err,undef,"No error loading Test2");
+is($ok,1,"Loaded Test2 successfully");
+ok(UNIVERSAL::isa($INC[0],"FatPacked"), '$INC[0] is still FatPacked');
+ok(UNIVERSAL::isa($INC{"Test1.pm"},"FatPacked"), '$INC{"Test1.pm"} is still FatPacked');
+is($INC{"Test2.pm"},"the_test_file", '$INC{"Test2.pm"} is as expected');
+is($INC[0],$INC{"Test1.pm"},'Same object in @INC and %INC');
+done_testing();