X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Finccode.t;h=49ab85fbc0045813305595c82706687c02a5089e;hb=0bc0ad857ef0ded50c72fba42503c958a1579a5a;hp=3ccea1a0a479b8380e02cf17ffb575c5e38719f1;hpb=69026470e9d2e2c7bf7b03f351d6e98a6d6f29f3;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/inccode.t b/t/op/inccode.t index 3ccea1a..49ab85f 100644 --- a/t/op/inccode.t +++ b/t/op/inccode.t @@ -10,7 +10,7 @@ BEGIN { use File::Spec; require "test.pl"; -plan(tests => 39); +plan(tests => 43); my @tempfiles = (); @@ -20,7 +20,7 @@ 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; } @@ -39,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( ref $INC{'Foo.pm'}, 'CODE', ' key is a coderef in %INC' ); -is( $INC{'Foo.pm'}, \&fooinc, ' key is correct in %INC' ); - -ok( eval "use Foo1; 1;", 'use()' ); -ok( exists $INC{'Foo1.pm'}, ' %INC sees it' ); -is( ref $INC{'Foo1.pm'}, 'CODE', ' key is a coderef in %INC' ); -is( $INC{'Foo1.pm'}, \&fooinc, ' key is correct in %INC' ); - -ok( eval { do 'Foo2.pl'; 1 }, 'do()' ); -ok( exists $INC{'Foo2.pl'}, ' %INC sees it' ); -is( ref $INC{'Foo2.pl'}, 'CODE', ' key is a coderef in %INC' ); -is( $INC{'Foo2.pl'}, \&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; @@ -72,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( ref $INC{'Bar.pm'}, 'ARRAY', ' key is an arrayref in %INC' ); -is( $INC{'Bar.pm'}, $arrayref, ' key is correct in %INC' ); - -ok( eval "use Bar1; 1;", 'use()' ); -ok( exists $INC{'Bar1.pm'}, ' %INC sees it' ); -is( ref $INC{'Bar1.pm'}, 'ARRAY', ' key is an arrayref in %INC' ); -is( $INC{'Bar1.pm'}, $arrayref, ' key is correct in %INC' ); - -ok( eval { do 'Bar2.pl'; 1 }, 'do()' ); -ok( exists $INC{'Bar2.pl'}, ' %INC sees it' ); -is( ref $INC{'Bar2.pl'}, 'ARRAY', ' key is an arrayref in %INC' ); -is( $INC{'Bar2.pl'}, $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; @@ -105,32 +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' ); +$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', - ' key is an object in %INC' ); -is( $INC{'Quux.pm'}, $href, ' key is correct in %INC' ); + ' 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' ); +$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', - ' key is an object in %INC' ); -is( $INC{'Quux1.pm'}, $aref, ' key is correct in %INC' ); + ' 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' ); +$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', - ' key is an object in %INC' ); -is( $INC{'Quux2.pm'}, $sref, ' key is correct in %INC' ); + ' 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;