Import perl-5.38.2

ok gkoehler@
Commit and we'll fix fallout bluhm@
Right away, please deraadt@

1 files changed, 215 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/t/op/hook/require.t b/gnu/usr.bin/perl/t/op/hook/require.t
new file mode 100644
index 00000000000..6957d16975e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/hook/require.t
@@ -0,0 +1,215 @@
+#!perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc( qw(../lib) );
+}
+
+use strict;
+use warnings;
+
+plan(tests => 14);
+
+{
+    fresh_perl_like(
+        '${^HOOK}{require__before} = "x";',
+        qr!\$\{\^HOOK\}\{require__before\} may only be a CODE reference or undef!,
+        { },
+        '%{^HOOK} forbids non code refs (string)');
+}
+{
+    fresh_perl_like(
+        '${^HOOK}{require__before} = [];',
+        qr!\$\{\^HOOK\}\{require__before\} may only be a CODE reference or undef!,
+        { },
+        '%{^HOOK} forbids non code refs (array)');
+}
+{
+    fresh_perl_like(
+        '${^HOOK}{require__before} = sub { die "Not allowed to load $_[0]" }; require Frobnitz;',
+        qr!Not allowed to load Frobnitz\.pm!,
+        { },
+        '${^HOOK}{require__before} exceptions stop require');
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '${^HOOK}{require__before} = '.
+        '  sub { my ($name) = @_; warn "before $name"; ' .
+        '       return sub { warn "after $name" } }; ' .
+        'require Apack;',
+        <<'EOF_WANT',
+before Apack.pm at - line 1.
+before Bpack.pm at - line 1.
+before Cpack.pm at - line 1.
+after Cpack.pm at - line 1.
+after Bpack.pm at - line 1.
+after Apack.pm at - line 1.
+EOF_WANT
+        { },
+        '${^HOOK}{require__before} with post action works as expected with t/lib/caller/Apack');
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '${^HOOK}{require__before} = '.
+        '  sub { $_[0] = "Apack.pm" if $_[0] eq "Cycle.pm";'.
+        '        my ($name) = @_; warn "before $name"; ' .
+        '        return sub { warn "after $name" } }; ' .
+        'require Cycle;',
+        <<'EOF_WANT',
+before Apack.pm at - line 1.
+before Bpack.pm at - line 1.
+before Cpack.pm at - line 1.
+after Cpack.pm at - line 1.
+after Bpack.pm at - line 1.
+after Apack.pm at - line 1.
+EOF_WANT
+        { },
+        '${^HOOK}{require__before} with filename rewrite works as expected (Cycle.pm -> Apack.pm)');
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '${^HOOK}{require__before} = '.
+        '  sub { my ($name) = @_; my $n = ++$::counter; warn "before $name ($n)"; ' .
+        '       return sub { warn "after $name ($n)" } }; ' .
+        'require Cycle;',
+        <<'EOF_WANT',
+before Cycle.pm (1) at - line 1.
+before Bicycle.pm (2) at - line 1.
+before Tricycle.pm (3) at - line 1.
+before Cycle.pm (4) at - line 1.
+after Cycle.pm (4) at - line 1.
+after Tricycle.pm (3) at - line 1.
+after Bicycle.pm (2) at - line 1.
+after Cycle.pm (1) at - line 1.
+EOF_WANT
+        { },
+        '${^HOOK}{require__before} with post action with state work as expected with t/lib/caller/Cycle');
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; my @seen;'.
+        '${^HOOK}{require__before} = '.
+        '  sub { die "Cycle detected: @seen $_[0]\n" if grep $_ eq $_[0], @seen; push @seen,$_[0]; ' .
+        '       return sub { pop @seen } }; ' .
+        'require Cycle;',
+        <<'EOF_WANT',
+Cycle detected: Cycle.pm Bicycle.pm Tricycle.pm Cycle.pm
+Compilation failed in require at lib/caller/Bicycle.pm line 1.
+Compilation failed in require at lib/caller/Cycle.pm line 1.
+Compilation failed in require at - line 1.
+EOF_WANT
+        { },
+        '${^HOOK}{require__before} with post action with state work as expected with t/lib/caller/Cycle');
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '${^HOOK}{require__before} = '.
+        '  sub { my ($before_name) = @_; warn "before $before_name"; ' .
+        '       return sub { my ($after_name) = @_; warn "after $after_name" } }; ' .
+        'require Apack;',
+        <<'EOF_WANT',
+before Apack.pm at - line 1.
+before Bpack.pm at - line 1.
+before Cpack.pm at - line 1.
+after Cpack.pm at - line 1.
+after Bpack.pm at - line 1.
+after Apack.pm at - line 1.
+EOF_WANT
+        { },
+        '${^HOOK}{require__before} with post action and name arg works as expected');
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '${^HOOK}{require__before} = '.
+        '  sub { my ($name) = @_; warn "before $name" };' .
+        'require Apack;',
+        <<'EOF_WANT',
+before Apack.pm at - line 1.
+before Bpack.pm at - line 1.
+before Cpack.pm at - line 1.
+EOF_WANT
+        { },
+        '${^HOOK}{require__before} with no post action works as expected with t/lib/caller/Apack');
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '${^HOOK}{require__after} = '.
+        '  sub { my ($name) = @_; warn "after $name" };' .
+        'require Apack;',
+        <<'EOF_WANT',
+after Cpack.pm at - line 1.
+after Bpack.pm at - line 1.
+after Apack.pm at - line 1.
+EOF_WANT
+        { },
+        '${^HOOK}{require__after} works as expected with t/lib/caller/Apack');
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '%{^HOOK} = ( require__before => sub { print "before: $_[0]\n" },
+                      require__after => sub { print "after: $_[0]\n" } );
+         { local %{^HOOK}; require Apack; }
+         print "done\n";',
+         "done\n",
+         { },
+         'local %{^HOOK} works to clear hooks.'
+    );
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '%{^HOOK} = ( require__before => sub { print "before: $_[0]\n" },
+                      require__after => sub { print "after: $_[0]\n" } );
+         { local %{^HOOK}; require Cycle; }
+         require Apack;',
+        <<'EOF_WANT',
+before: Apack.pm
+before: Bpack.pm
+before: Cpack.pm
+after: Cpack.pm
+after: Bpack.pm
+after: Apack.pm
+EOF_WANT
+         { },
+         'local %{^HOOK} works to clear and restore hooks.'
+    );
+}
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '%{^HOOK} = ( require__before => sub { print "before: $_[0]\n" } );
+         %{^HOOK} = ( require__after  => sub { print "after: $_[0]\n" } );
+         require Apack;',
+        <<'EOF_WANT',
+after: Cpack.pm
+after: Bpack.pm
+after: Apack.pm
+EOF_WANT
+         { },
+         '%{^HOOK} = (...); works as expected (part 1)'
+    );
+}
+
+{
+    fresh_perl_is(
+        'use lib "./lib/caller"; '.
+        '%{^HOOK} = ( require__after  => sub { print "after: $_[0]\n" } );
+         %{^HOOK} = ( require__before => sub { print "before: $_[0]\n" } );
+         require Apack;',
+        <<'EOF_WANT',
+before: Apack.pm
+before: Bpack.pm
+before: Cpack.pm
+EOF_WANT
+         { },
+         '%{^HOOK} = (...); works as expected (part 2)'
+    );
+}