xref: /openbsd/gnu/usr.bin/perl/dist/IO/t/io_getline.t (revision 097a140d) 
1#!./perl -w
2use strict;
3
4use Test::More tests => 37;
5
6my $File = 'README';
7
8use IO::File;
9
10my $io = IO::File->new($File);
11isa_ok($io, 'IO::File', "Opening $File");
12
13my $line = $io->getline();
14like($line, qr/^This is the/, "Read first line");
15
16my ($list, $context) = $io->getline();
17is($list, "\n", "Read second line");
18is($context, undef, "Did not read third line with getline() in list context");
19
20$line = $io->getline();
21like($line, qr/^This distribution/, "Read third line");
22
23my @lines = $io->getlines();
24cmp_ok(@lines, '>', 3, "getlines reads lots of lines");
25like($lines[-2], qr/^Share and Enjoy!/, "Share and Enjoy!");
26
27$line = $io->getline();
28is($line, undef, "geline reads no more at EOF");
29
30@lines = $io->getlines();
31is(@lines, 0, "gelines reads no more at EOF");
32
33# And again
34$io = IO::File->new($File);
35isa_ok($io, 'IO::File', "Opening $File");
36
37$line = $io->getline();
38like($line, qr/^This is the/, "Read first line again");
39
40is(eval {
41    $line = $io->getline("Boom");
42    1;
43   }, undef, "eval caught an exception");
44like($@, qr/^usage.*getline\(\) at .*\bio_getline\.t line /, 'getline usage');
45like($line, qr/^This is the/, '$line unchanged');
46
47is(eval {
48    ($list, $context) = $io->getlines("Boom");
49    1;
50   }, undef, "eval caught an exception");
51like($@, qr/^usage.*getlines\(\) at .*\bio_getline\.t line /, 'getlines usage');
52is($list, "\n", '$list unchanged');
53
54is(eval {
55    $line = $io->getlines();
56    1;
57   }, undef, "eval caught an exception");
58like($@, qr/^Can't call .*getlines in a scalar context.* at .*\bio_getline\.t line /,
59     'getlines in scalar context croaks');
60like($line, qr/^This is the/, '$line unchanged');
61
62is(eval {
63    $io->getlines();
64    1;
65   }, undef, "eval caught an exception");
66like($@, qr/^Can't call .*getlines in a scalar context.* at .*\bio_getline\.t line /,
67     'getlines in void context croaks');
68like($line, qr/^This is the/, '$line unchanged');
69
70($list, $context) = $io->getlines();
71is($list, "\n", "Read second line");
72like($context, qr/^This distribution/, "Read third line");
73
74{
75    package TiedHandle;
76
77    sub TIEHANDLE {
78        return bless ["Tick", "tick", "tick"];
79    }
80
81    sub READLINE {
82        my $fh = shift;
83        die "Boom!"
84            unless @$fh;
85        return shift @$fh
86            unless wantarray;
87        return splice @$fh;
88    }
89}
90
91tie *FH, 'TiedHandle';
92
93is(*FH->getline(), "Tick", "tied handle read works");
94($list, $context) = *FH->getline();
95is($list, "tick", "tied handle read works in list context 0");
96is($context, undef, "tied handle read works in list context 1");
97is(*FH->getline(), "tick", "tied handle read works again");
98is(eval {
99    $line = *FH->getline();
100    1;
101   }, undef, "eval on tied handle caught an exception");
102like($@, qr/^Boom!/,
103     'getline on tied handle propagates exception');
104like($line, qr/^This is the/, '$line unchanged');
105
106tie *FH, 'TiedHandle';
107
108($list, $context) = *FH->getlines();
109is($list, "Tick", "tied handle read works in list context 2");
110is($context, "tick", "tied handle read works in list context 3");
111is(eval {
112    ($list, $context) = *FH->getlines();
113    1;
114   }, undef, "eval on tied handle caught an exception again");
115like($@, qr/^Boom!/,
116     'getlines on tied handle propagates exception');
117is($list, "Tick", '$line unchanged');
118