xref: /openbsd-src/gnu/usr.bin/perl/dist/IO/t/io_getline.t (revision de8cc8edbc71bd3e3bc7fbffa27ba0e564c37d8b)

#!./perl -w
use strict;

use Test::More tests => 37;

my $File = 'README';

use IO::File;

my $io = IO::File->new($File);
isa_ok($io, 'IO::File', "Opening $File");

my $line = $io->getline();
like($line, qr/^This is the/, "Read first line");

my ($list, $context) = $io->getline();
is($list, "\n", "Read second line");
is($context, undef, "Did not read third line with getline() in list context");

$line = $io->getline();
like($line, qr/^This distribution/, "Read third line");

my @lines = $io->getlines();
cmp_ok(@lines, '>', 3, "getlines reads lots of lines");
like($lines[-2], qr/^Share and Enjoy!/, "Share and Enjoy!");

$line = $io->getline();
is($line, undef, "geline reads no more at EOF");

@lines = $io->getlines();
is(@lines, 0, "gelines reads no more at EOF");

# And again
$io = IO::File->new($File);
isa_ok($io, 'IO::File', "Opening $File");

$line = $io->getline();
like($line, qr/^This is the/, "Read first line again");

is(eval {
    $line = $io->getline("Boom");
    1;
   }, undef, "eval caught an exception");
like($@, qr/^usage.*getline\(\) at .*\bio_getline\.t line /, 'getline usage');
like($line, qr/^This is the/, '$line unchanged');

is(eval {
    ($list, $context) = $io->getlines("Boom");
    1;
   }, undef, "eval caught an exception");
like($@, qr/^usage.*getlines\(\) at .*\bio_getline\.t line /, 'getlines usage');
is($list, "\n", '$list unchanged');

is(eval {
    $line = $io->getlines();
    1;
   }, undef, "eval caught an exception");
like($@, qr/^Can't call .*getlines in a scalar context.* at .*\bio_getline\.t line /,
     'getlines in scalar context croaks');
like($line, qr/^This is the/, '$line unchanged');

is(eval {
    $io->getlines();
    1;
   }, undef, "eval caught an exception");
like($@, qr/^Can't call .*getlines in a scalar context.* at .*\bio_getline\.t line /,
     'getlines in void context croaks');
like($line, qr/^This is the/, '$line unchanged');

($list, $context) = $io->getlines();
is($list, "\n", "Read second line");
like($context, qr/^This distribution/, "Read third line");

{
    package TiedHandle;

    sub TIEHANDLE {
        return bless ["Tick", "tick", "tick"];
    }

    sub READLINE {
        my $fh = shift;
        die "Boom!"
            unless @$fh;
        return shift @$fh
            unless wantarray;
        return splice @$fh;
    }
}

tie *FH, 'TiedHandle';

is(*FH->getline(), "Tick", "tied handle read works");
($list, $context) = *FH->getline();
is($list, "tick", "tied handle read works in list context 0");
is($context, undef, "tied handle read works in list context 1");
is(*FH->getline(), "tick", "tied handle read works again");
is(eval {
    $line = *FH->getline();
    1;
   }, undef, "eval on tied handle caught an exception");
like($@, qr/^Boom!/,
     'getline on tied handle propagates exception');
like($line, qr/^This is the/, '$line unchanged');

tie *FH, 'TiedHandle';

($list, $context) = *FH->getlines();
is($list, "Tick", "tied handle read works in list context 2");
is($context, "tick", "tied handle read works in list context 3");
is(eval {
    ($list, $context) = *FH->getlines();
    1;
   }, undef, "eval on tied handle caught an exception again");
like($@, qr/^Boom!/,
     'getlines on tied handle propagates exception');
is($list, "Tick", '$line unchanged');