This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Replace the use Test::More in t/{op,io,run} with t/test.pl.
[perl5.git] / t / op / inccode.t
CommitLineData
69026470 1#!./perl -w
e5d18500
AMS
2
3# Tests for the coderef-in-@INC feature
4
5BEGIN {
f8973f08 6 chdir 't' if -d 't';
69026470 7 @INC = qw(. ../lib);
e5d18500 8}
f8973f08 9
47de4e93 10use File::Spec;
69026470
JH
11
12require "test.pl";
13plan(tests => 39);
47de4e93 14
22e2837f
RGS
15my @tempfiles = ();
16
47de4e93 17sub get_temp_fh {
22e2837f
RGS
18 my $f = "DummyModule0000";
19 1 while -e ++$f;
20 push @tempfiles, $f;
21 open my $fh, ">$f" or die "Can't create $f: $!";
47de4e93
RGS
22 print $fh "package ".substr($_[0],0,-3)."; 1;";
23 close $fh;
24 open $fh, $f or die "Can't open $f: $!";
25 return $fh;
26}
f8973f08 27
22e2837f
RGS
28END { 1 while unlink @tempfiles }
29
e5d18500
AMS
30sub fooinc {
31 my ($self, $filename) = @_;
32 if (substr($filename,0,3) eq 'Foo') {
47de4e93 33 return get_temp_fh($filename);
e5d18500
AMS
34 }
35 else {
f8973f08 36 return undef;
e5d18500
AMS
37 }
38}
39
40push @INC, \&fooinc;
41
f8973f08
MS
42ok( !eval { require Bar; 1 }, 'Trying non-magic package' );
43
44ok( eval { require Foo; 1 }, 'require() magic via code ref' );
45ok( exists $INC{'Foo.pm'}, ' %INC sees it' );
6ece0f6b
RGS
46is( ref $INC{'Foo.pm'}, 'CODE', ' key is a coderef in %INC' );
47is( $INC{'Foo.pm'}, \&fooinc, ' key is correct in %INC' );
f8973f08
MS
48
49ok( eval "use Foo1; 1;", 'use()' );
50ok( exists $INC{'Foo1.pm'}, ' %INC sees it' );
6ece0f6b
RGS
51is( ref $INC{'Foo1.pm'}, 'CODE', ' key is a coderef in %INC' );
52is( $INC{'Foo1.pm'}, \&fooinc, ' key is correct in %INC' );
f8973f08
MS
53
54ok( eval { do 'Foo2.pl'; 1 }, 'do()' );
55ok( exists $INC{'Foo2.pl'}, ' %INC sees it' );
6ece0f6b
RGS
56is( ref $INC{'Foo2.pl'}, 'CODE', ' key is a coderef in %INC' );
57is( $INC{'Foo2.pl'}, \&fooinc, ' key is correct in %INC' );
e5d18500
AMS
58
59pop @INC;
60
f8973f08 61
e5d18500
AMS
62sub fooinc2 {
63 my ($self, $filename) = @_;
64 if (substr($filename, 0, length($self->[1])) eq $self->[1]) {
47de4e93 65 return get_temp_fh($filename);
e5d18500
AMS
66 }
67 else {
f8973f08 68 return undef;
e5d18500
AMS
69 }
70}
71
47de4e93
RGS
72my $arrayref = [ \&fooinc2, 'Bar' ];
73push @INC, $arrayref;
e5d18500 74
f8973f08
MS
75ok( eval { require Foo; 1; }, 'Originally loaded packages preserved' );
76ok( !eval { require Foo3; 1; }, 'Original magic INC purged' );
77
78ok( eval { require Bar; 1 }, 'require() magic via array ref' );
79ok( exists $INC{'Bar.pm'}, ' %INC sees it' );
6ece0f6b
RGS
80is( ref $INC{'Bar.pm'}, 'ARRAY', ' key is an arrayref in %INC' );
81is( $INC{'Bar.pm'}, $arrayref, ' key is correct in %INC' );
f8973f08
MS
82
83ok( eval "use Bar1; 1;", 'use()' );
84ok( exists $INC{'Bar1.pm'}, ' %INC sees it' );
6ece0f6b
RGS
85is( ref $INC{'Bar1.pm'}, 'ARRAY', ' key is an arrayref in %INC' );
86is( $INC{'Bar1.pm'}, $arrayref, ' key is correct in %INC' );
f8973f08
MS
87
88ok( eval { do 'Bar2.pl'; 1 }, 'do()' );
89ok( exists $INC{'Bar2.pl'}, ' %INC sees it' );
6ece0f6b
RGS
90is( ref $INC{'Bar2.pl'}, 'ARRAY', ' key is an arrayref in %INC' );
91is( $INC{'Bar2.pl'}, $arrayref, ' key is correct in %INC' );
e5d18500
AMS
92
93pop @INC;
94
95sub FooLoader::INC {
96 my ($self, $filename) = @_;
97 if (substr($filename,0,4) eq 'Quux') {
47de4e93 98 return get_temp_fh($filename);
e5d18500
AMS
99 }
100 else {
f8973f08 101 return undef;
e5d18500
AMS
102 }
103}
104
47de4e93
RGS
105my $href = bless( {}, 'FooLoader' );
106push @INC, $href;
e5d18500 107
f8973f08
MS
108ok( eval { require Quux; 1 }, 'require() magic via hash object' );
109ok( exists $INC{'Quux.pm'}, ' %INC sees it' );
6ece0f6b
RGS
110is( ref $INC{'Quux.pm'}, 'FooLoader',
111 ' key is an object in %INC' );
112is( $INC{'Quux.pm'}, $href, ' key is correct in %INC' );
e5d18500
AMS
113
114pop @INC;
115
47de4e93
RGS
116my $aref = bless( [], 'FooLoader' );
117push @INC, $aref;
e5d18500 118
f8973f08
MS
119ok( eval { require Quux1; 1 }, 'require() magic via array object' );
120ok( exists $INC{'Quux1.pm'}, ' %INC sees it' );
6ece0f6b
RGS
121is( ref $INC{'Quux1.pm'}, 'FooLoader',
122 ' key is an object in %INC' );
123is( $INC{'Quux1.pm'}, $aref, ' key is correct in %INC' );
e5d18500
AMS
124
125pop @INC;
126
47de4e93
RGS
127my $sref = bless( \(my $x = 1), 'FooLoader' );
128push @INC, $sref;
e5d18500 129
f8973f08
MS
130ok( eval { require Quux2; 1 }, 'require() magic via scalar object' );
131ok( exists $INC{'Quux2.pm'}, ' %INC sees it' );
6ece0f6b
RGS
132is( ref $INC{'Quux2.pm'}, 'FooLoader',
133 ' key is an object in %INC' );
134is( $INC{'Quux2.pm'}, $sref, ' key is correct in %INC' );
f8973f08
MS
135
136pop @INC;