diff --git a/lib/App/Yath/Script/V1.pm b/lib/App/Yath/Script/V1.pm index 2f60b1879..2ce9c39a5 100644 --- a/lib/App/Yath/Script/V1.pm +++ b/lib/App/Yath/Script/V1.pm @@ -21,7 +21,8 @@ sub do_begin { my $ORIG_TMP_PERMS; my %ORIG_SIG = map { defined($SIG{$_}) ? ($_ => "$SIG{$_}") : () } keys %SIG; my @ORIG_ARGV = @$argv; - my @ORIG_INC = @INC; + # Skip @INC hook refs (coderef / arrayref / blessed); they can't cross exec via -I nor round-trip JSON. + my @ORIG_INC = grep { ref $_ eq '' } @INC; my %CONFIG; @ARGV = @$argv; diff --git a/lib/Test2/Harness/Util.pm b/lib/Test2/Harness/Util.pm index 9e408aea5..2c5070cb5 100644 --- a/lib/Test2/Harness/Util.pm +++ b/lib/Test2/Harness/Util.pm @@ -104,7 +104,8 @@ sub process_includes { @list = @start; } - push @list => @INC if delete $params{include_current}; + # Skip @INC hook refs; clean_path would stringify them to bogus paths. + push @list => grep { ref $_ eq '' } @INC if delete $params{include_current}; @list = map { $_ eq '.' ? $_ : clean_path($_) || $_ } @list if delete $params{clean}; diff --git a/t/integration/inc_hook.t b/t/integration/inc_hook.t new file mode 100644 index 000000000..6bb492a48 --- /dev/null +++ b/t/integration/inc_hook.t @@ -0,0 +1,63 @@ +use Test2::V0; + +use File::Spec; + +use App::Yath::Tester qw/yath/; + +use App::Yath::Util qw/find_yath/; +find_yath(); + +my $dir = __FILE__; +$dir =~ s{\.t$}{}g; + +my $hook_dir = File::Spec->rel2abs($dir); +my $target = File::Spec->catfile($hook_dir, 'simple.tx'); + +# Each fixture injects one of the three @INC hook forms documented in +# perlvar "@INC": blessed object, coderef, arrayref. Without filtering, +# the ref would be snapshotted into settings->harness->orig_inc, crash +# JSON encoding in write_settings_to, and inject "HASH(0x...)" / +# "CODE(0x...)" / "ARRAY(0x...)" garbage paths into child -I flags. +my @cases = ( + { + name => 'blessed object hook', + module => 'FakeHook', + ref_re => qr/FakeHook=HASH\(/, + }, + { + name => 'coderef hook', + module => 'CoderefHook', + ref_re => qr{/CODE\(0x}, + }, + { + name => 'arrayref hook', + module => 'ArrayrefHook', + ref_re => qr{/ARRAY\(0x}, + }, +); + +for my $case (@cases) { + yath( + command => 'test', + args => [$target], + env => { + PERL5OPT => "-I$hook_dir -M$case->{module}", + }, + exit => 0, + test => sub { + my $out = shift; + unlike( + $out->{output}, + qr/encountered object/, + "$case->{name}: no JSON encode error", + ); + unlike( + $out->{output}, + $case->{ref_re}, + "$case->{name}: no stringified ref leaked into output", + ); + }, + ); +} + +done_testing; diff --git a/t/integration/inc_hook/ArrayrefHook.pm b/t/integration/inc_hook/ArrayrefHook.pm new file mode 100644 index 000000000..6e8226c5a --- /dev/null +++ b/t/integration/inc_hook/ArrayrefHook.pm @@ -0,0 +1,7 @@ +package ArrayrefHook; +use strict; +use warnings; + +unshift @INC, [sub { return }]; + +1; diff --git a/t/integration/inc_hook/CoderefHook.pm b/t/integration/inc_hook/CoderefHook.pm new file mode 100644 index 000000000..6820f10b6 --- /dev/null +++ b/t/integration/inc_hook/CoderefHook.pm @@ -0,0 +1,7 @@ +package CoderefHook; +use strict; +use warnings; + +unshift @INC, sub { return }; + +1; diff --git a/t/integration/inc_hook/FakeHook.pm b/t/integration/inc_hook/FakeHook.pm new file mode 100644 index 000000000..acc5a533d --- /dev/null +++ b/t/integration/inc_hook/FakeHook.pm @@ -0,0 +1,10 @@ +package FakeHook; +use strict; +use warnings; + +# INC is a special identifier that lives in main::, hence the FQN. +sub FakeHook::INC { return } + +unshift @INC, bless({}, __PACKAGE__); + +1; diff --git a/t/integration/inc_hook/simple.tx b/t/integration/inc_hook/simple.tx new file mode 100644 index 000000000..4aae73687 --- /dev/null +++ b/t/integration/inc_hook/simple.tx @@ -0,0 +1,5 @@ +use Test2::V0; + +ok(1, 'basic test runs under @INC hook'); + +done_testing;