From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 15 Apr 2006 11:59:26 +0000 (+0000)
Subject: Add a test for source filters returned from code references in @INC.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bde61959ea5e52e421c597172a9aeac53357fcd9;p=p5sagit%2Fp5-mst-13.2.git

Add a test for source filters returned from code references in @INC.

p4raw-id: //depot/perl@27811
---

diff --git a/MANIFEST b/MANIFEST
index 5c618a4..e45ccad 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3365,6 +3365,7 @@ t/op/hashassign.t		See if hash assignments work
 t/op/hash.t			See if the complexity attackers are repelled
 t/op/hashwarn.t			See if warnings for bad hash assignments work
 t/op/inccode.t			See if coderefs work in @INC
+t/op/incfilter.t		See if the source filters in coderef-in-@INC work
 t/op/inc.t			See if inc/dec of integers near 32 bit limit work
 t/op/index.t			See if index works
 t/op/int.t			See if int works
diff --git a/t/op/incfilter.t b/t/op/incfilter.t
new file mode 100644
index 0000000..9e273c3
--- /dev/null
+++ b/t/op/incfilter.t
@@ -0,0 +1,62 @@
+#!./perl -w
+
+# Tests for the source filters in coderef-in-@INC
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(. ../lib);
+    unless (find PerlIO::Layer 'perlio') {
+	print "1..0 # Skip: not perlio\n";
+	exit 0;
+    }
+    require "test.pl";
+}
+use strict;
+
+plan(tests => 12);
+
+unshift @INC, sub {
+    no warnings 'uninitialized';
+    ref $_[1] eq 'ARRAY' ? @{$_[1]} : $_[1];
+};
+
+my $fh;
+
+open $fh, "<", \'pass("Can return file handles from \@INC");';
+do $fh;
+
+my @origlines = ("# This is a blank line\n",
+		 "pass('Can return generators from \@INC');\n",
+		 "pass('Which return multiple lines');\n",
+		 "1",
+		 );
+my @lines = @origlines;
+sub generator {
+    $_ = shift @lines;
+    # Return of 0 marks EOF
+    return defined $_ ? 1 : 0;
+};
+
+do \&generator;
+
+@lines = @origlines;
+# Check that the array dereferencing works ready for the more complex tests:
+do [\&generator];
+
+do [sub {
+	my $param = $_[1];
+	is (ref $param, 'ARRAY', "Got our parameter");
+	$_ = shift @$param;
+	return defined $_ ? 1 : 0;
+    }, ["pass('Can return generators which take state');\n",
+	"pass('And return multiple lines');\n",
+	]];
+   
+
+open $fh, "<", \'fail("File handles and filters work from \@INC");';
+
+do [$fh, sub {s/fail/pass/}];
+
+open $fh, "<", \'fail("File handles and filters with state work from \@INC");';
+
+do [$fh, sub {s/$_[1]/pass/}, 'fail'];