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 (my $line = <$p>) {
                push(@l, $line);
            }
            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 (my $line = <$p>) {
                push(@l, $line);
            }
            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);