Commit | Line | Data |
---|---|---|
73dbc821 YO |
1 | #!perl -w |
2 | ||
3 | # Check that modifying %INC during an @INC hook does not | |
4 | # clobber the hook by modifying @INC at the same time. | |
5 | # See GitHub Issue #20577 | |
6 | ||
7 | chdir "t" if -d "t"; | |
8 | require './test.pl'; | |
9 | skip_all_if_miniperl("as PerlIO layer 'scalar' not supported under miniperl"); | |
10 | set_up_inc( '../lib' ); | |
11 | eval <<'EOF' or die $@; | |
12 | { | |
13 | my %fatpacked; | |
14 | ||
15 | $fatpacked{"Test1.pm"} = <<'TEST1'; | |
16 | package Test1; | |
17 | sub import { | |
18 | my $filename = 'Test2.pm'; | |
19 | $INC{$filename} = "the_test_file"; | |
20 | } | |
21 | 1; | |
22 | TEST1 | |
23 | ||
24 | $fatpacked{"Test2.pm"} = <<'TEST2'; | |
25 | package Test2; | |
26 | use Test1; | |
27 | 1; | |
28 | TEST2 | |
29 | ||
30 | my $class = 'FatPacked'; | |
31 | no strict 'refs'; | |
32 | ||
33 | *{"${class}::INC"} = sub { | |
34 | if ( my $fat = $_[0]{ $_[1] } ) { | |
35 | open my $fh, '<', \$fat | |
36 | or die; | |
37 | return $fh; | |
38 | } | |
39 | return; | |
40 | }; | |
41 | ||
42 | unshift @INC, bless \%fatpacked, $class; | |
43 | } | |
44 | 1 | |
45 | EOF | |
46 | ||
47 | ok(UNIVERSAL::isa($INC[0],"FatPacked"), '$INC[0] starts FatPacked'); | |
48 | ok(!exists $INC{"Test1.pm"}, 'Test1.pm not in %INC'); | |
49 | ok(!exists $INC{"Test2.pm"}, 'Test2.pm not in %INC'); | |
50 | my $ok= eval "use Test2; 1"; | |
51 | my $err= !$ok ? $@ : undef; | |
52 | is($err,undef,"No error loading Test2"); | |
53 | is($ok,1,"Loaded Test2 successfully"); | |
54 | ok(UNIVERSAL::isa($INC[0],"FatPacked"), '$INC[0] is still FatPacked'); | |
55 | ok(UNIVERSAL::isa($INC{"Test1.pm"},"FatPacked"), '$INC{"Test1.pm"} is still FatPacked'); | |
56 | is($INC{"Test2.pm"},"the_test_file", '$INC{"Test2.pm"} is as expected'); | |
57 | is($INC[0],$INC{"Test1.pm"},'Same object in @INC and %INC'); | |
58 | done_testing(); |