[PATCH] new tests for the coderef-in-@INC

From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
Date: Mon, 27 Aug 2001 22:36:27 +0200
Message-Id: <20010827223627.C690@rafael>

Subject: Re: [PATCH] new tests for the coderef-in-@INC
From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 28 Aug 2001 00:02:46 +0100
Message-Id: <20010828000245.R4950@plum.flirble.org>

p4raw-id: //depot/perl@11764

diff --git a/MANIFEST b/MANIFEST
index 4d6a7a2..aec8de1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2034,6 +2034,7 @@ t/op/groups.t                     See if $( works
 t/op/gv.t                      See if typeglobs work
 t/op/hashwarn.t                        See if warnings for bad hash assignments work
 t/op/inc.t                     See if inc/dec of integers near 32 bit limit work
+t/op/inccode.t                 See if coderefs work in @INC
 t/op/index.t                   See if index works
 t/op/int.t                     See if int works
 t/op/join.t                    See if join works

diff --git a/t/op/inccode.t b/t/op/inccode.t
new file mode 100644 (file)
index 0000000..9b35e84
--- /dev/null
+++ b/t/op/inccode.t
@@ -0,0 +1,95 @@
+#!./perl -w
+
+# Tests for the coderef-in-@INC feature
+
+BEGIN {
+  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";
+
+sub fooinc {
+    my ($self, $filename) = @_;
+    if (substr($filename,0,3) eq 'Foo') {
+       open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
+       return $fh;
+    }
+    else {
+       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";
+
+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;
+    }
+    else {
+       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";
+
+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;
+    }
+    else {
+       return undef;
+    }
+}
+
+push @INC, bless( {}, 'FooLoader' );
+
+print "not " if ! eval { require Quux } or ! exists $INC{'Quux.pm'};
+print "ok 10\n";
+
+pop @INC;
+
+push @INC, bless( [], 'FooLoader' );
+
+print "not " if ! eval { require Quux1 } or ! exists $INC{'Quux1.pm'};
+print "ok 11\n";
+
+pop @INC;
+
+push @INC, bless( \(my $x = 1), 'FooLoader' );
+
+print "not " if ! eval { require Quux2 } or ! exists $INC{'Quux2.pm'};
+print "ok 12\n";