This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
[perl5.git] / t / op / inccode.t
1 #!./perl -wT
2
3 # Tests for the coderef-in-@INC feature
4
5 BEGIN {
6     chdir 't' if -d 't';
7     @INC = '../lib';
8 }
9
10 use Config;
11
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 }
25
26 sub fooinc {
27     my ($self, $filename) = @_;
28     if (substr($filename,0,3) eq 'Foo') {
29         open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
30         return $fh;
31     }
32     else {
33         return undef;
34     }
35 }
36
37 push @INC, \&fooinc;
38
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' );
49
50 pop @INC;
51
52
53 sub fooinc2 {
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;");
57         return $fh;
58     }
59     else {
60         return undef;
61     }
62 }
63
64 push @INC, [ \&fooinc2, 'Bar' ];
65
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' );
77
78 pop @INC;
79
80 sub FooLoader::INC {
81     my ($self, $filename) = @_;
82     if (substr($filename,0,4) eq 'Quux') {
83         open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
84         return $fh;
85     }
86     else {
87         return undef;
88     }
89 }
90
91 push @INC, bless( {}, 'FooLoader' );
92
93 ok( eval { require Quux; 1 },      'require() magic via hash object' );
94 ok( exists $INC{'Quux.pm'},        '  %INC sees it' );
95
96 pop @INC;
97
98 push @INC, bless( [], 'FooLoader' );
99
100 ok( eval { require Quux1; 1 },     'require() magic via array object' );
101 ok( exists $INC{'Quux1.pm'},       '  %INC sees it' );
102
103 pop @INC;
104
105 push @INC, bless( \(my $x = 1), 'FooLoader' );
106
107 ok( eval { require Quux2; 1 },     'require() magic via scalar object' );
108 ok( exists $INC{'Quux2.pm'},       '  %INC sees it' );
109
110 pop @INC;