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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
use strict;
use warnings;
use IO::Scalar;
use Symbol qw(geniosym); # tied file handle NON-BAREWORD
use Test::More;
plan tests => 39;
# Some data
my @orig = (
"A diner while dining at Crewe\n",
"Found a rather large mouse in his stew\n",
" Said the waiter, \"Don't shout,\n",
" And wave it about..."
);
my @extra = (
"\nor the rest",
" will be wanting one ",
"too.\"\n",
);
my $s = join('', @orig);
my $whole = $s . join('', @extra);
# start testing
my $io = IO::Scalar->new(\$s);
ok($io, "open: open a scalar on a ref to a string");
is($io->fileno(), undef, "fileno() returns undef");
# test print
{
ok($io->print($extra[0]), "print: able to print");
ok($io->print(@extra[1,2]), "print: able to print again");
# is("$io", $whole, "Whole string matches");
}
# getc
{
my @c_str;
$io->seek(0,0);
for my $i (0..2) {
$c_str[$i] = $io->getc;
}
is($c_str[0], 'A', 'seek/getc: got A');
is($c_str[1], ' ', 'seek/getc: got space');
is($c_str[2], 'd', 'seek/getc: got d');
}
# getline
{
my $str;
$io->seek(3,0);
$str = $io->getline;
is($str, "iner while dining at Crewe\n", 'getline: got the line');
$str = undef;
$str = $io->getline;
is($str, "Found a rather large mouse in his stew\n", 'getline: get subsequent line');
$str = undef;
# we know we're trying to grab too many lines
for (0..5) {
$str = $io->getline;
}
is($str, undef, 'getline: repeat past end of stream');
}
# read
{
my $buff;
$io->seek(0, 0);
$io->read($buff, 10);
is($buff, 'A diner wh', 'read: read(10) got correct value');
$buff = undef;
$io->read($buff, 10);
is($buff, 'ile dining', 'read: read(10) again got correct value');
is($io->tell, 20, 'tell: got correct current position');
$buff = undef;
$io->seek(0, 0);
$io->read($buff, 1000);
is($buff, $whole, 'read(1000): got full slurped value');
}
# seek
{
my $buff;
$io->seek(2, 0);
$io->read($buff, 5);
is($buff, 'diner', 'seek(2,0) - read: got correct value');
$buff = undef;
$io->seek(-6, 2);
$io->read($buff, 3);
is($buff, 'too', 'seek(-6,2) - read(): got correct value');
$buff = undef;
$io->seek(-7, 1);
$io->read($buff, 7);
is($buff, 'one too', 'seek(-7,1) - read(): got correct value');
}
# tie
{
my $th = geniosym;
tie(*{$th}, 'IO::Scalar');
ok($th, 'tie: got tied handle');
print {$th} @orig;
tied(*{$th})->seek(0, 0);
my @lines;
while (my $line = <$th>) {
push @lines, $line;
}
is(join('', @lines), join('', @orig), 'tied seek readline: got correct value');
@lines = ();
tied(*{$th})->seek(0, 0);
@lines = <$th>;
is(join('', @lines), join('', @orig), 'tied seek readlines: got correct value');
}
# record seps
{
my @lines = (
"par 1, line 1\n",
"par 1, line 2\n",
"\n",
"\n",
"\n",
"\n",
"par 2, line 1\n",
"\n",
"par 3, line 1\n",
"par 3, line 2\n",
"par 3, line 3",
);
my $all = join('', @lines);
# Slurp everything
{
my $ios = IO::Scalar->new(\$all);
local $/ = undef;
is($ios->getline, $all, "recordsep: undef - getline");
}
# Read a little, slurp the rest
{
my $ios = IO::Scalar->new(\$all);
is($ios->getline, $lines[0], "recordsep: undef - get first line");
local $/ = undef;
is($ios->getline, join('', @lines[1..$#lines]), "recordsep: undef - slurp the rest");
}
# Read paragraph by paragraph
{
my $ios = IO::Scalar->new(\$all);
local $/ = "";
is($ios->getline, join('', @lines[0..2]), "recordsep: empty - first par");
is($ios->getline, join('', @lines[6..7]), "recordsep: empty - second par");
is($ios->getline, join('', @lines[8..10]), "recordsep empty - third par");
}
# Read record by record
{
my $ios = IO::Scalar->new(\$all);
local $/ = "1,";
is($ios->getline, "par 1,", "recordsep: custom - first rec");
is($ios->getline, " line 1\npar 1,", "recordsep: custom - second rec");
}
# Read line by line
{
my $ios = IO::Scalar->new(\$all);
local $/ = "\n";
for my $i (0..10) {
is($ios->getline, $lines[$i], "recordsep: newline - rec $i");
}
}
}
|
