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
187
188
189
190
191
192
193
194
195
196
|
#!./perl
BEGIN {
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
}
plan(36);
$TST = 'TST';
$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'dos' or
$^O eq 'os2' or $^O eq 'cygwin' or
$^O =~ /^uwin/);
open($TST, 'harness') || (die "Can't open harness");
binmode $TST if $Is_Dosish;
ok(!eof(TST), "eof is false after open() non-empty file");
$firstline = <$TST>;
$secondpos = tell;
$x = 0;
while (<TST>) {
if (eof) {$x++;}
}
is($x, 1, "only one eof is in the file");
$lastpos = tell;
ok(eof, "tell() doesn't change current state of eof");
ok(seek($TST,0,0), "set current position at beginning of the file");
ok(!eof, "reset at beginning of file clears eof flag");
is($firstline, <TST>, "first line is the same after open() and after seek()");
is($secondpos, tell, "position is the same after reading the first line");
ok(seek(TST,0,1), "move current position on +0");
ok(!eof($TST), "it doesn't set eof flag");
is($secondpos, tell, "it doesn't change tell position");
ok(seek(TST,0,2), "move current position at the end of the file");
is($lastpos, tell, "the position is the same as after reading whole file line by line");
ok(eof, "it sets eof flag");
ok($., "current line number \$. is not null");
$curline = $.;
open(OTHER, 'harness') || (die "Can't open harness: $!");
binmode OTHER if (($^O eq 'MSWin32') || ($^O eq 'NetWare'));
{
local($.);
ok($., "open() doesn't change filehandler for \$.");
tell OTHER;
ok(!$., "tell() does change filehandler for \$.");
$. = 5;
scalar <OTHER>;
is ($., 6, "reading of one line adds +1 to current line number \$.");
}
is($., $curline, "the 'local' correctly restores old value of filehandler for \$. when goes out of scope");
{
local($.);
scalar <OTHER>;
is($., 7, "reading of one line inside 'local' change filehandler for \$.");
}
is($., $curline, "the 'local' correctly restores old value of filehandler for \$. when goes out of scope");
{
local($.);
tell OTHER;
is($., 7, "tell() inside 'local' change filehandler for \$.");
}
close(OTHER);
{
no warnings 'closed';
is(tell(OTHER), -1, "tell() for closed file returns -1");
}
{
no warnings 'unopened';
# this must be a handle that has never been opened
is(tell(UNOPENED), -1, "tell() for unopened file returns -1");
}
# ftell(STDIN) (or any std streams) is undefined, it can return -1 or
# something else. ftell() on pipes, fifos, and sockets is defined to
# return -1.
my $written = tempfile();
close($TST);
open($tst,">$written") || die "Cannot open $written:$!";
binmode $tst if $Is_Dosish;
is(tell($tst), 0, "tell() for new file returns 0");
print $tst "fred\n";
is(tell($tst), 5, 'tell() after writing "fred\n" returns 5');
print $tst "more\n";
is(tell($tst), 10, 'tell() after writing "more\n" returns 10');
close($tst);
open($tst,"+>>$written") || die "Cannot open $written:$!";
binmode $tst if $Is_Dosish;
if (0)
{
# :stdio does not pass these so ignore them for now
is(tell($tst), 0, 'tell() for open mode "+>>" returns 0');
$line = <$tst>;
is($line, "fred\n", 'check first line in mode "+>>"');
is(tell($tst), 5, "check tell() afrer reading first line");
}
print $tst "xxxx\n";
ok( tell($tst) == 15 ||
tell($tst) == 5,
'check tell() after writing "xxxx\n"'); # unset PERLIO or PERLIO=stdio (e.g. HP-UX, Solaris)
close($tst);
open($tst,">$written") || die "Cannot open $written:$!";
print $tst "foobar";
close $tst;
open($tst,">>$written") || die "Cannot open $written:$!";
# This test makes a questionable assumption that the file pointer will
# be at eof after opening a file but before seeking, reading, or writing.
# The POSIX standard is vague on this point.
# Cygwin and VOS differ from other implementations.
if (tell ($tst) == 6) {
pass("check tell() after writing in mode '>>'");
}
else {
if (($^O eq "cygwin") && (&PerlIO::get_layers($tst) eq 'stdio')) {
fail "# TODO: file pointer not at eof";
}
elsif ($^O eq "vos") {
fail "# TODO: Hit bug posix-2056. file pointer not at eof";
}
else {
fail "file pointer not at eof";
}
}
close $tst;
open FH, "test.pl";
$fh = *FH; # coercible glob
is(tell($fh), 0, "tell on coercible glob");
is(tell, 0, "argless tell after tell \$coercible");
tell *$fh;
is(tell, 0, "argless tell after tell *\$coercible");
eof $fh;
is(tell, 0, "argless tell after eof \$coercible");
eof *$fh;
is(tell, 0, "argless tell after eof *\$coercible");
seek $fh,0,0;
is(tell, 0, "argless tell after seek \$coercible...");
seek *$fh,0,0;
is(tell, 0, "argless tell after seek *\$coercible...");
{
# [perl #133721]
fresh_perl_is(<<'EOI', 'ok', {}, 'eof with no ${^LAST_FH}');
print "ok" if eof;
EOI
}
|
