X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Finccode.t;h=49ab85fbc0045813305595c82706687c02a5089e;hb=0bc0ad857ef0ded50c72fba42503c958a1579a5a;hp=95ee7c0094e14187d3a58f448af6a93f1a7b86fa;hpb=22e2837f3c603836f14e7ecdf873d47a2e95cda5;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/inccode.t b/t/op/inccode.t index 95ee7c0..49ab85f 100644 --- a/t/op/inccode.t +++ b/t/op/inccode.t @@ -1,14 +1,16 @@ -#!./perl -wT +#!./perl -w # Tests for the coderef-in-@INC feature BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + @INC = qw(. ../lib); } use File::Spec; -use Test::More tests => 30; + +require "test.pl"; +plan(tests => 43); my @tempfiles = (); @@ -18,19 +20,13 @@ sub get_temp_fh { push @tempfiles, $f; open my $fh, ">$f" or die "Can't create $f: $!"; print $fh "package ".substr($_[0],0,-3)."; 1;"; - close $fh; + close $fh or die "Couldn't close: $!"; open $fh, $f or die "Can't open $f: $!"; return $fh; } END { 1 while unlink @tempfiles } -sub get_addr { - my $str = shift; - $str =~ /(0x[0-9a-f]+)/i; - return $1; -} - sub fooinc { my ($self, $filename) = @_; if (substr($filename,0,3) eq 'Foo') { @@ -43,22 +39,29 @@ sub fooinc { push @INC, \&fooinc; -ok( !eval { require Bar; 1 }, 'Trying non-magic package' ); - -ok( eval { require Foo; 1 }, 'require() magic via code ref' ); -ok( exists $INC{'Foo.pm'}, ' %INC sees it' ); -is( get_addr($INC{'Foo.pm'}), get_addr(\&fooinc), - ' key is correct in %INC' ); - -ok( eval "use Foo1; 1;", 'use()' ); -ok( exists $INC{'Foo1.pm'}, ' %INC sees it' ); -is( get_addr($INC{'Foo1.pm'}), get_addr(\&fooinc), - ' key is correct in %INC' ); - -ok( eval { do 'Foo2.pl'; 1 }, 'do()' ); -ok( exists $INC{'Foo2.pl'}, ' %INC sees it' ); -is( get_addr($INC{'Foo2.pl'}), get_addr(\&fooinc), - ' key is correct in %INC' ); +my $evalret = eval { require Bar; 1 }; +ok( !$evalret, 'Trying non-magic package' ); + +$evalret = eval { require Foo; 1 }; +die $@ if $@; +ok( $evalret, 'require Foo; magic via code ref' ); +ok( exists $INC{'Foo.pm'}, ' %INC sees Foo.pm' ); +is( ref $INC{'Foo.pm'}, 'CODE', ' val Foo.pm is a coderef in %INC' ); +is( $INC{'Foo.pm'}, \&fooinc, ' val Foo.pm is correct in %INC' ); + +$evalret = eval "use Foo1; 1;"; +die $@ if $@; +ok( $evalret, 'use Foo1' ); +ok( exists $INC{'Foo1.pm'}, ' %INC sees Foo1.pm' ); +is( ref $INC{'Foo1.pm'}, 'CODE', ' val Foo1.pm is a coderef in %INC' ); +is( $INC{'Foo1.pm'}, \&fooinc, ' val Foo1.pm is correct in %INC' ); + +$evalret = eval { do 'Foo2.pl'; 1 }; +die $@ if $@; +ok( $evalret, 'do "Foo2.pl"' ); +ok( exists $INC{'Foo2.pl'}, ' %INC sees Foo2.pl' ); +is( ref $INC{'Foo2.pl'}, 'CODE', ' val Foo2.pl is a coderef in %INC' ); +is( $INC{'Foo2.pl'}, \&fooinc, ' val Foo2.pl is correct in %INC' ); pop @INC; @@ -76,23 +79,28 @@ sub fooinc2 { my $arrayref = [ \&fooinc2, 'Bar' ]; push @INC, $arrayref; -ok( eval { require Foo; 1; }, 'Originally loaded packages preserved' ); -ok( !eval { require Foo3; 1; }, 'Original magic INC purged' ); - -ok( eval { require Bar; 1 }, 'require() magic via array ref' ); -ok( exists $INC{'Bar.pm'}, ' %INC sees it' ); -is( get_addr($INC{'Bar.pm'}), get_addr($arrayref), - ' key is correct in %INC' ); - -ok( eval "use Bar1; 1;", 'use()' ); -ok( exists $INC{'Bar1.pm'}, ' %INC sees it' ); -is( get_addr($INC{'Bar1.pm'}), get_addr($arrayref), - ' key is correct in %INC' ); - -ok( eval { do 'Bar2.pl'; 1 }, 'do()' ); -ok( exists $INC{'Bar2.pl'}, ' %INC sees it' ); -is( get_addr($INC{'Bar2.pl'}), get_addr($arrayref), - ' key is correct in %INC' ); +$evalret = eval { require Foo; 1; }; +die $@ if $@; +ok( $evalret, 'Originally loaded packages preserved' ); +$evalret = eval { require Foo3; 1; }; +ok( !$evalret, 'Original magic INC purged' ); + +$evalret = eval { require Bar; 1 }; +die $@ if $@; +ok( $evalret, 'require Bar; magic via array ref' ); +ok( exists $INC{'Bar.pm'}, ' %INC sees Bar.pm' ); +is( ref $INC{'Bar.pm'}, 'ARRAY', ' val Bar.pm is an arrayref in %INC' ); +is( $INC{'Bar.pm'}, $arrayref, ' val Bar.pm is correct in %INC' ); + +ok( eval "use Bar1; 1;", 'use Bar1' ); +ok( exists $INC{'Bar1.pm'}, ' %INC sees Bar1.pm' ); +is( ref $INC{'Bar1.pm'}, 'ARRAY', ' val Bar1.pm is an arrayref in %INC' ); +is( $INC{'Bar1.pm'}, $arrayref, ' val Bar1.pm is correct in %INC' ); + +ok( eval { do 'Bar2.pl'; 1 }, 'do "Bar2.pl"' ); +ok( exists $INC{'Bar2.pl'}, ' %INC sees Bar2.pl' ); +is( ref $INC{'Bar2.pl'}, 'ARRAY', ' val Bar2.pl is an arrayref in %INC' ); +is( $INC{'Bar2.pl'}, $arrayref, ' val Bar2.pl is correct in %INC' ); pop @INC; @@ -109,29 +117,58 @@ sub FooLoader::INC { my $href = bless( {}, 'FooLoader' ); push @INC, $href; -ok( eval { require Quux; 1 }, 'require() magic via hash object' ); -ok( exists $INC{'Quux.pm'}, ' %INC sees it' ); -is( get_addr($INC{'Quux.pm'}), get_addr($href), - ' key is correct in %INC' ); +$evalret = eval { require Quux; 1 }; +die $@ if $@; +ok( $evalret, 'require Quux; magic via hash object' ); +ok( exists $INC{'Quux.pm'}, ' %INC sees Quux.pm' ); +is( ref $INC{'Quux.pm'}, 'FooLoader', + ' val Quux.pm is an object in %INC' ); +is( $INC{'Quux.pm'}, $href, ' val Quux.pm is correct in %INC' ); pop @INC; my $aref = bless( [], 'FooLoader' ); push @INC, $aref; -ok( eval { require Quux1; 1 }, 'require() magic via array object' ); -ok( exists $INC{'Quux1.pm'}, ' %INC sees it' ); -is( get_addr($INC{'Quux1.pm'}), get_addr($aref), - ' key is correct in %INC' ); +$evalret = eval { require Quux1; 1 }; +die $@ if $@; +ok( $evalret, 'require Quux1; magic via array object' ); +ok( exists $INC{'Quux1.pm'}, ' %INC sees Quux1.pm' ); +is( ref $INC{'Quux1.pm'}, 'FooLoader', + ' val Quux1.pm is an object in %INC' ); +is( $INC{'Quux1.pm'}, $aref, ' val Quux1.pm is correct in %INC' ); pop @INC; my $sref = bless( \(my $x = 1), 'FooLoader' ); push @INC, $sref; -ok( eval { require Quux2; 1 }, 'require() magic via scalar object' ); -ok( exists $INC{'Quux2.pm'}, ' %INC sees it' ); -is( get_addr($INC{'Quux2.pm'}), get_addr($sref), - ' key is correct in %INC' ); +$evalret = eval { require Quux2; 1 }; +die $@ if $@; +ok( $evalret, 'require Quux2; magic via scalar object' ); +ok( exists $INC{'Quux2.pm'}, ' %INC sees Quux2.pm' ); +is( ref $INC{'Quux2.pm'}, 'FooLoader', + ' val Quux2.pm is an object in %INC' ); +is( $INC{'Quux2.pm'}, $sref, ' val Quux2.pm is correct in %INC' ); + +pop @INC; + +push @INC, sub { + my ($self, $filename) = @_; + if (substr($filename,0,4) eq 'Toto') { + $INC{$filename} = 'xyz'; + return get_temp_fh($filename); + } + else { + return undef; + } +}; + +$evalret = eval { require Toto; 1 }; +die $@ if $@; +ok( $evalret, 'require Toto; magic via anonymous code ref' ); +ok( exists $INC{'Toto.pm'}, ' %INC sees Toto.pm' ); +ok( ! ref $INC{'Toto.pm'}, q/ val Toto.pm isn't a ref in %INC/ ); +is( $INC{'Toto.pm'}, 'xyz', ' val Toto.pm is correct in %INC' ); pop @INC;