Commit | Line | Data |
f8973f08 |
1 | #!./perl -wT |
e5d18500 |
2 | |
3 | # Tests for the coderef-in-@INC feature |
4 | |
5 | BEGIN { |
f8973f08 |
6 | chdir 't' if -d 't'; |
7 | @INC = '../lib'; |
e5d18500 |
8 | } |
f8973f08 |
9 | |
e5d18500 |
10 | use Config; |
e5d18500 |
11 | |
f8973f08 |
12 | BEGIN { |
13 | require Test::More; |
14 | |
15 | # This test relies on perlio, but the feature being tested does not. |
16 | # The dependency should eventually be purged and use something like |
17 | # Tie::Handle instead. |
18 | if( $Config{useperlio} ) { |
19 | Test::More->import(tests => 21); |
20 | } |
21 | else { |
22 | Test::More->import('skip_all'); |
23 | } |
24 | } |
e5d18500 |
25 | |
26 | sub fooinc { |
27 | my ($self, $filename) = @_; |
28 | if (substr($filename,0,3) eq 'Foo') { |
f8973f08 |
29 | open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); |
30 | return $fh; |
e5d18500 |
31 | } |
32 | else { |
f8973f08 |
33 | return undef; |
e5d18500 |
34 | } |
35 | } |
36 | |
37 | push @INC, \&fooinc; |
38 | |
f8973f08 |
39 | ok( !eval { require Bar; 1 }, 'Trying non-magic package' ); |
40 | |
41 | ok( eval { require Foo; 1 }, 'require() magic via code ref' ); |
42 | ok( exists $INC{'Foo.pm'}, ' %INC sees it' ); |
43 | |
44 | ok( eval "use Foo1; 1;", 'use()' ); |
45 | ok( exists $INC{'Foo1.pm'}, ' %INC sees it' ); |
46 | |
47 | ok( eval { do 'Foo2.pl'; 1 }, 'do()' ); |
48 | ok( exists $INC{'Foo2.pl'}, ' %INC sees it' ); |
e5d18500 |
49 | |
50 | pop @INC; |
51 | |
f8973f08 |
52 | |
e5d18500 |
53 | sub fooinc2 { |
54 | my ($self, $filename) = @_; |
55 | if (substr($filename, 0, length($self->[1])) eq $self->[1]) { |
f8973f08 |
56 | open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); |
57 | return $fh; |
e5d18500 |
58 | } |
59 | else { |
f8973f08 |
60 | return undef; |
e5d18500 |
61 | } |
62 | } |
63 | |
64 | push @INC, [ \&fooinc2, 'Bar' ]; |
65 | |
f8973f08 |
66 | ok( eval { require Foo; 1; }, 'Originally loaded packages preserved' ); |
67 | ok( !eval { require Foo3; 1; }, 'Original magic INC purged' ); |
68 | |
69 | ok( eval { require Bar; 1 }, 'require() magic via array ref' ); |
70 | ok( exists $INC{'Bar.pm'}, ' %INC sees it' ); |
71 | |
72 | ok( eval "use Bar1; 1;", 'use()' ); |
73 | ok( exists $INC{'Bar1.pm'}, ' %INC sees it' ); |
74 | |
75 | ok( eval { do 'Bar2.pl'; 1 }, 'do()' ); |
76 | ok( exists $INC{'Bar2.pl'}, ' %INC sees it' ); |
e5d18500 |
77 | |
78 | pop @INC; |
79 | |
80 | sub FooLoader::INC { |
81 | my ($self, $filename) = @_; |
82 | if (substr($filename,0,4) eq 'Quux') { |
f8973f08 |
83 | open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); |
84 | return $fh; |
e5d18500 |
85 | } |
86 | else { |
f8973f08 |
87 | return undef; |
e5d18500 |
88 | } |
89 | } |
90 | |
91 | push @INC, bless( {}, 'FooLoader' ); |
92 | |
f8973f08 |
93 | ok( eval { require Quux; 1 }, 'require() magic via hash object' ); |
94 | ok( exists $INC{'Quux.pm'}, ' %INC sees it' ); |
e5d18500 |
95 | |
96 | pop @INC; |
97 | |
98 | push @INC, bless( [], 'FooLoader' ); |
99 | |
f8973f08 |
100 | ok( eval { require Quux1; 1 }, 'require() magic via array object' ); |
101 | ok( exists $INC{'Quux1.pm'}, ' %INC sees it' ); |
e5d18500 |
102 | |
103 | pop @INC; |
104 | |
105 | push @INC, bless( \(my $x = 1), 'FooLoader' ); |
106 | |
f8973f08 |
107 | ok( eval { require Quux2; 1 }, 'require() magic via scalar object' ); |
108 | ok( exists $INC{'Quux2.pm'}, ' %INC sees it' ); |
109 | |
110 | pop @INC; |