3 # Tests for the coderef-in-@INC feature
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);
22 Test::More->import('skip_all');
27 my ($self, $filename) = @_;
28 if (substr($filename,0,3) eq 'Foo') {
29 open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
39 ok( !eval { require Bar; 1 }, 'Trying non-magic package' );
41 ok( eval { require Foo; 1 }, 'require() magic via code ref' );
42 ok( exists $INC{'Foo.pm'}, ' %INC sees it' );
44 ok( eval "use Foo1; 1;", 'use()' );
45 ok( exists $INC{'Foo1.pm'}, ' %INC sees it' );
47 ok( eval { do 'Foo2.pl'; 1 }, 'do()' );
48 ok( exists $INC{'Foo2.pl'}, ' %INC sees it' );
54 my ($self, $filename) = @_;
55 if (substr($filename, 0, length($self->[1])) eq $self->[1]) {
56 open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
64 push @INC, [ \&fooinc2, 'Bar' ];
66 ok( eval { require Foo; 1; }, 'Originally loaded packages preserved' );
67 ok( !eval { require Foo3; 1; }, 'Original magic INC purged' );
69 ok( eval { require Bar; 1 }, 'require() magic via array ref' );
70 ok( exists $INC{'Bar.pm'}, ' %INC sees it' );
72 ok( eval "use Bar1; 1;", 'use()' );
73 ok( exists $INC{'Bar1.pm'}, ' %INC sees it' );
75 ok( eval { do 'Bar2.pl'; 1 }, 'do()' );
76 ok( exists $INC{'Bar2.pl'}, ' %INC sees it' );
81 my ($self, $filename) = @_;
82 if (substr($filename,0,4) eq 'Quux') {
83 open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
91 push @INC, bless( {}, 'FooLoader' );
93 ok( eval { require Quux; 1 }, 'require() magic via hash object' );
94 ok( exists $INC{'Quux.pm'}, ' %INC sees it' );
98 push @INC, bless( [], 'FooLoader' );
100 ok( eval { require Quux1; 1 }, 'require() magic via array object' );
101 ok( exists $INC{'Quux1.pm'}, ' %INC sees it' );
105 push @INC, bless( \(my $x = 1), 'FooLoader' );
107 ok( eval { require Quux2; 1 }, 'require() magic via scalar object' );
108 ok( exists $INC{'Quux2.pm'}, ' %INC sees it' );