[p5sagit/p5-mst-13.2.git] / t / op / incfilter.t

#!./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;
use Filter::Util::Call;

plan(tests => 19);

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 or die;

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 or die;

@lines = @origlines;
# Check that the array dereferencing works ready for the more complex tests:
do [\&generator] or die;

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",
	]] or die;
   

open $fh, "<", \'fail("File handles and filters work from \@INC");';

do [$fh, sub {s/fail/pass/}] or die;

open $fh, "<", \'fail("File handles and filters with state work from \@INC");';

do [$fh, sub {s/$_[1]/pass/}, 'fail'] or die;

print "# 2 tests with pipes from subprocesses.\n";

open $fh, 'echo pass|' or die $!;

do $fh or die;

open $fh, 'echo fail|' or die $!;

do [$fh, sub {s/$_[1]/pass/}, 'fail'] or die;

sub rot13_filter {
    filter_add(sub {
		   my $status = filter_read();
		   tr/A-Za-z/N-ZA-Mn-za-m/;
		   $status;
	       })
}

open $fh, "<", \<<'EOC';
BEGIN {rot13_filter};
cnff("This will rot13'ed prepend");
EOC

do $fh or die;

open $fh, "<", \<<'EOC';
ORTVA {ebg13_svygre};
pass("This will rot13'ed twice");
EOC

do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/;}] or die;

my $count = 32;
sub prepend_rot13_filter {
    filter_add(sub {
		   my $previous = defined $_ ? $_ : '';
		   # Filters should append to any existing data in $_
		   # But (logically) shouldn't filter it twice.
		   my $test = "fzrt!";
		   $_ = $test;
		   my $status = filter_read();
		   # Sadly, doing this inside the source filter causes an
		   # infinte loop
		   my $got = substr $_, 0, length $test, '';
		   is $got, $test, "Upstream didn't alter existing data";
		   tr/A-Za-z/N-ZA-Mn-za-m/;
		   $_ = $previous . $_;
		   die "Looping infinitely" unless $count--;
		   $status;
	       })
}

open $fh, "<", \<<'EOC';
ORTVA {cercraq_ebg13_svygre};
pass("This will rot13'ed twice");
EOC

do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/;}] or die;
Commit	Line	Data
bde61959	1	#!./perl -w
	2
	3	# Tests for the source filters in coderef-in-@INC
	4
	5	BEGIN {
	6	chdir 't' if -d 't';
	7	@INC = qw(. ../lib);
	8	unless (find PerlIO::Layer 'perlio') {
	9	print "1..0 # Skip: not perlio\n";
	10	exit 0;
	11	}
	12	require "test.pl";
	13	}
	14	use strict;
5675696b	15	use Filter::Util::Call;
bde61959	16
5675696b	17	plan(tests => 19);
bde61959	18
	19	unshift @INC, sub {
	20	no warnings 'uninitialized';
	21	ref $_[1] eq 'ARRAY' ? @{$_[1]} : $_[1];
	22	};
	23
	24	my $fh;
	25
	26	open $fh, "<", \'pass("Can return file handles from \@INC");';
5675696b	27	do $fh or die;
bde61959	28
	29	my @origlines = ("# This is a blank line\n",
	30	"pass('Can return generators from \@INC');\n",
	31	"pass('Which return multiple lines');\n",
	32	"1",
	33	);
	34	my @lines = @origlines;
	35	sub generator {
	36	$_ = shift @lines;
	37	# Return of 0 marks EOF
	38	return defined $_ ? 1 : 0;
	39	};
	40
5675696b	41	do \&generator or die;
bde61959	42
	43	@lines = @origlines;
	44	# Check that the array dereferencing works ready for the more complex tests:
5675696b	45	do [\&generator] or die;
bde61959	46
	47	do [sub {
	48	my $param = $_[1];
	49	is (ref $param, 'ARRAY', "Got our parameter");
	50	$_ = shift @$param;
	51	return defined $_ ? 1 : 0;
	52	}, ["pass('Can return generators which take state');\n",
	53	"pass('And return multiple lines');\n",
5675696b	54	]] or die;
bde61959	55
	56
	57	open $fh, "<", \'fail("File handles and filters work from \@INC");';
	58
5675696b	59	do [$fh, sub {s/fail/pass/}] or die;
bde61959	60
	61	open $fh, "<", \'fail("File handles and filters with state work from \@INC");';
	62
5675696b	63	do [$fh, sub {s/$_[1]/pass/}, 'fail'] or die;
	64
	65	print "# 2 tests with pipes from subprocesses.\n";
	66
	67	open $fh, 'echo pass\|' or die $!;
	68
	69	do $fh or die;
	70
	71	open $fh, 'echo fail\|' or die $!;
	72
	73	do [$fh, sub {s/$_[1]/pass/}, 'fail'] or die;
	74
	75	sub rot13_filter {
	76	filter_add(sub {
	77	my $status = filter_read();
	78	tr/A-Za-z/N-ZA-Mn-za-m/;
	79	$status;
	80	})
	81	}
	82
	83	open $fh, "<", \<<'EOC';
	84	BEGIN {rot13_filter};
	85	cnff("This will rot13'ed prepend");
	86	EOC
	87
	88	do $fh or die;
	89
	90	open $fh, "<", \<<'EOC';
	91	ORTVA {ebg13_svygre};
	92	pass("This will rot13'ed twice");
	93	EOC
	94
	95	do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/;}] or die;
	96
	97	my $count = 32;
	98	sub prepend_rot13_filter {
	99	filter_add(sub {
	100	my $previous = defined $_ ? $_ : '';
	101	# Filters should append to any existing data in $_
	102	# But (logically) shouldn't filter it twice.
	103	my $test = "fzrt!";
	104	$_ = $test;
	105	my $status = filter_read();
	106	# Sadly, doing this inside the source filter causes an
	107	# infinte loop
	108	my $got = substr $_, 0, length $test, '';
	109	is $got, $test, "Upstream didn't alter existing data";
	110	tr/A-Za-z/N-ZA-Mn-za-m/;
	111	$_ = $previous . $_;
	112	die "Looping infinitely" unless $count--;
	113	$status;
	114	})
	115	}
	116
	117	open $fh, "<", \<<'EOC';
	118	ORTVA {cercraq_ebg13_svygre};
	119	pass("This will rot13'ed twice");
	120	EOC
	121
	122	do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/;}] or die;