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

I wrote some basic tests for the coderef-in-@INC feature.
I placed them in a new file t/op/inccode.t (I also patched MANIFEST).

Note : I use extensively the idiom
	open my $fh, '<', \$scalar
in those tests, to return a new filehandle without using an external file.
I hope it's OK.

--- /dev/null	Thu Aug 24 11:00:32 2000
+++ t/op/inccode.t	Mon Aug 27 22:17:27 2001
@@ -0,0 +1,88 @@
+#!./perl
+
+# Tests for the coderef-in-@INC feature
+
+chdir 't' if -d 't';
+@INC = '../lib';
+
+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";
--- MANIFEST.orig	Sat Aug 25 17:59:20 2001
+++ MANIFEST	Mon Aug 27 22:21:29 2001
@@ -2034,6 +2034,7 @@
 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

• [PATCH] new tests for the coderef-in-@INC by Rafael Garcia-Suarez
• Re: [PATCH] new tests for the coderef-in-@INC by Nicholas Clark
• Re: [PATCH] new tests for the coderef-in-@INC by Michael G Schwern