From: Michael G. Schwern Date: Mon, 27 Aug 2001 19:47:30 +0000 (-0400) Subject: Re: [PATCH] new tests for the coderef-in-@INC X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8973f081d87ec67aa5cfc32129ad0144a08c6de;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH] new tests for the coderef-in-@INC Message-Id: <20010827194730.C12582@blackrider> p4raw-id: //depot/perl@11765 --- diff --git a/t/op/inccode.t b/t/op/inccode.t index 9b35e84..85a235d 100644 --- a/t/op/inccode.t +++ b/t/op/inccode.t @@ -1,95 +1,110 @@ -#!./perl -w +#!./perl -wT # Tests for the coderef-in-@INC feature BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + chdir 't' if -d 't'; + @INC = '../lib'; } + use Config; -unless ($Config{useperlio}) { - print "1..0 # Skipping (tests are implemented using perlio features, this perl uses stdio)\n"; - exit 0; -} -print "1..12\n"; +BEGIN { + require Test::More; + + # This test relies on perlio, but the feature being tested does not. + # The dependency should eventually be purged and use something like + # Tie::Handle instead. + if( $Config{useperlio} ) { + Test::More->import(tests => 21); + } + else { + Test::More->import('skip_all'); + } +} sub fooinc { my ($self, $filename) = @_; if (substr($filename,0,3) eq 'Foo') { - open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); - return $fh; + open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); + return $fh; } else { - return undef; + return undef; } } push @INC, \&fooinc; -print "not " if eval { require Bar }; -print "ok 1\n"; -print "not " if ! eval { require Foo } or ! exists $INC{'Foo.pm'}; -print "ok 2\n"; -print "not " if ! eval "use Foo1; 1;" or ! exists $INC{'Foo1.pm'}; -print "ok 3\n"; -print "not " if ! eval { do 'Foo2.pl' } or ! exists $INC{'Foo2.pl'}; -print "ok 4\n"; +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' ); + +ok( eval "use Foo1; 1;", 'use()' ); +ok( exists $INC{'Foo1.pm'}, ' %INC sees it' ); + +ok( eval { do 'Foo2.pl'; 1 }, 'do()' ); +ok( exists $INC{'Foo2.pl'}, ' %INC sees it' ); pop @INC; + sub fooinc2 { my ($self, $filename) = @_; if (substr($filename, 0, length($self->[1])) eq $self->[1]) { - open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); - return $fh; + open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); + return $fh; } else { - return undef; + return undef; } } push @INC, [ \&fooinc2, 'Bar' ]; -print "not " if ! eval { require Foo }; # Already loaded -print "ok 5\n"; -print "not " if eval { require Foo3 }; -print "ok 6\n"; -print "not " if ! eval { require Bar } or ! exists $INC{'Bar.pm'}; -print "ok 7\n"; -print "not " if ! eval "use Bar1; 1;" or ! exists $INC{'Bar1.pm'}; -print "ok 8\n"; -print "not " if ! eval { do 'Bar2.pl' } or ! exists $INC{'Bar2.pl'}; -print "ok 9\n"; +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' ); + +ok( eval "use Bar1; 1;", 'use()' ); +ok( exists $INC{'Bar1.pm'}, ' %INC sees it' ); + +ok( eval { do 'Bar2.pl'; 1 }, 'do()' ); +ok( exists $INC{'Bar2.pl'}, ' %INC sees it' ); pop @INC; sub FooLoader::INC { my ($self, $filename) = @_; if (substr($filename,0,4) eq 'Quux') { - open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); - return $fh; + open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;"); + return $fh; } else { - return undef; + return undef; } } push @INC, bless( {}, 'FooLoader' ); -print "not " if ! eval { require Quux } or ! exists $INC{'Quux.pm'}; -print "ok 10\n"; +ok( eval { require Quux; 1 }, 'require() magic via hash object' ); +ok( exists $INC{'Quux.pm'}, ' %INC sees it' ); pop @INC; push @INC, bless( [], 'FooLoader' ); -print "not " if ! eval { require Quux1 } or ! exists $INC{'Quux1.pm'}; -print "ok 11\n"; +ok( eval { require Quux1; 1 }, 'require() magic via array object' ); +ok( exists $INC{'Quux1.pm'}, ' %INC sees it' ); pop @INC; push @INC, bless( \(my $x = 1), 'FooLoader' ); -print "not " if ! eval { require Quux2 } or ! exists $INC{'Quux2.pm'}; -print "ok 12\n"; +ok( eval { require Quux2; 1 }, 'require() magic via scalar object' ); +ok( exists $INC{'Quux2.pm'}, ' %INC sees it' ); + +pop @INC;