IO-Event

 view release on metacpan or  search on metacpan

t/getline.tt  view on Meta::CPAN

	},
	{ #3
		send => "woa frog\n",
		acquire =>	sub {
			print "about to getline() a line\n" if $debug;
			puller()->getline()
		},
		compare => "woa frog\n",
		desc => 'copy one line: print method & getline method',
		repeat => 1,
	},
	{ #4
		send =>		sub {
			my $p = pusher();
			print $p "foo\nbar\n";
		},
		acquire =>	sub {
			my $p = puller();
			return <$p>;
		},
		compare => [ "foo\n", "bar\n" ],
		repeat => 1,
		array => 1,
		desc => 'copy two lines: print filehandle & <filehandle>',
	},
	{ #5
		send =>		sub {
			my $p = pusher();
			printf $p "%s\n%s\n", 'foo', 'baz';
		},
		acquire =>	sub {
			my $p = puller();
			return <$p>;
		},
		compare => [ "foo\n", "baz\n" ],
		repeat => 1,
		array => 1,
		desc => 'copy two lines: printf filehandle & <filehandle>',
	},
	{ #6
		send =>		sub {
			pusher()->print("abc123");
		},
		acquire =>	sub {
			my ($s, $ibr, $t) = @_;
			return '' unless length($$ibr) >= 6;
			my $p = puller();
			my $x;
			read($p, $x, 3);
			die unless length($x) == 3;
			read($p, $x, 3, 3);
			return $x;
		},
		compare => "abc123",
		repeat => 1,
		desc => 'copy 2x3 chars: print method & read filehandle',
	},
	{ #7
		send =>		sub {
			pusher()->print("a\nb\n\nc\n\n\nd\n\n\n\ne\n");
			$/ = '';
		},
		acquire =>	sub {
			my $p = puller();
			return <$p>;
		},
		compare => [ "a\nb\n\n", "c\n\n", "d\n\n", "e\n" ],
		repeat => 1,
		array => 1,
		desc => 'copy 4 sets many lines: print method & array context <filehandle>',
	},
	{ #8
		send =>		sub {
			$/ = '';
			pusher()->print("a\nb\n\nc\n\n\nd\n\n\n\ne\n");
		},
		acquire =>	sub {
			my $p = puller();
			my @l;
			while (<$p>) {
				push(@l, $_);
			}
			return @l;
		},
		compare => [ "a\nb\n\n", "c\n\n", "d\n\n", "e\n" ],
		repeat => 1,
		array => 1,
		desc => 'copy 4 sets many lines: print method & scalar context <filehandle>',
	},
	{ #9
		send =>		sub {
			pusher()->print("\n\n\na\nb\n\nc\n\n\nd\n\n\n\ne\n");
		},
		connect => 	sub {
			$/ = "xyz";
			puller()->input_record_separator('');
		},
		acquire =>	sub {
			my $p = puller();
			return <$p>;
		},
		compare => [ "a\nb\n\n", "c\n\n", "d\n\n", "e\n" ],
		repeat => 1,
		array => 1,
		desc => 'copy 4 sets many lines: print method & <filehandle> with $/ funny',
	},
	{ #10
		send =>		sub {
			pusher()->print("\n\na\nb\n\nc\n\n\nd\n\n\n\ne\n");
		},
		connect =>	sub {
			$/ = "xyz";
			puller()->input_record_separator('');
		},
		acquire =>	sub {
			my $p = puller();
			my @l;
			while (<$p>) {
				push(@l, $_);
			}
			return @l;
		},
		compare => [ "a\nb\n\n", "c\n\n", "d\n\n", "e\n" ],
		repeat => 1,
		array => 1,
		desc => 'copy 4 sets many lines: print method & scalar <filehandle> with $/ funny',
	},
	{ #11
		send =>		sub {
			pusher()->print("xyz124abc567");
		},
		connect =>	sub {
			$/ = "\n";
			puller()->input_record_separator(3);



( run in 0.594 second using v1.01-cache-2.11-cpan-800906f7e73 )