From: Abhijit Menon-Sen <ams@wiw.org>
Date: Mon, 27 Aug 2001 22:46:21 +0000 (+0000)
Subject: [PATCH] new tests for the coderef-in-@INC
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e5d18500ab9b6e628b63861d5ca05d19285ceda5;p=p5sagit%2Fp5-mst-13.2.git

[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
--- 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
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";