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 (file)
--- 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;