1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
#!./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');
|
