This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
First "eof" should return true
[perl5.git] / t / io / tell.t
CommitLineData
8d063cd8
LW
1#!./perl
2
58c59f01
NC
3BEGIN {
4 chdir 't' if -d 't';
62a28c97 5 require './test.pl';
624c42e2 6 set_up_inc('../lib');
58c59f01
NC
7}
8
b4e880f3 9plan(36);
8d063cd8 10
3fb41248 11$TST = 'TST';
378cc40b 12
2986a63f 13$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'dos' or
cd86ed9d 14 $^O eq 'os2' or $^O eq 'cygwin' or
cebd85e6 15 $^O =~ /^uwin/);
8736538c 16
2eb25c99 17open($TST, 'harness') || (die "Can't open harness");
8736538c 18binmode $TST if $Is_Dosish;
a55c21fc 19ok(!eof(TST), "eof is false after open() non-empty file");
8d063cd8 20
378cc40b 21$firstline = <$TST>;
8d063cd8
LW
22$secondpos = tell;
23
24$x = 0;
3fb41248 25while (<TST>) {
8d063cd8
LW
26 if (eof) {$x++;}
27}
a55c21fc 28is($x, 1, "only one eof is in the file");
8d063cd8
LW
29
30$lastpos = tell;
31
a55c21fc 32ok(eof, "tell() doesn't change current state of eof");
8d063cd8 33
a55c21fc 34ok(seek($TST,0,0), "set current position at beginning of the file");
8d063cd8 35
a55c21fc 36ok(!eof, "reset at beginning of file clears eof flag");
8d063cd8 37
a55c21fc 38is($firstline, <TST>, "first line is the same after open() and after seek()");
8d063cd8 39
a55c21fc 40is($secondpos, tell, "position is the same after reading the first line");
8d063cd8 41
a55c21fc 42ok(seek(TST,0,1), "move current position on +0");
8d063cd8 43
a55c21fc 44ok(!eof($TST), "it doesn't set eof flag");
8d063cd8 45
a55c21fc 46is($secondpos, tell, "it doesn't change tell position");
8d063cd8 47
a55c21fc 48ok(seek(TST,0,2), "move current position at the end of the file");
8d063cd8 49
a55c21fc 50is($lastpos, tell, "the position is the same as after reading whole file line by line");
8d063cd8 51
a55c21fc 52ok(eof, "it sets eof flag");
455ece5e 53
a55c21fc 54ok($., "current line number \$. is not null");
455ece5e
AD
55
56$curline = $.;
3fb41248
SP
57open(OTHER, 'harness') || (die "Can't open harness: $!");
58binmode OTHER if (($^O eq 'MSWin32') || ($^O eq 'NetWare'));
455ece5e
AD
59
60{
61 local($.);
62
a55c21fc 63 ok($., "open() doesn't change filehandler for \$.");
455ece5e 64
3fb41248 65 tell OTHER;
a55c21fc 66 ok(!$., "tell() does change filehandler for \$.");
455ece5e
AD
67
68 $. = 5;
3fb41248 69 scalar <OTHER>;
a55c21fc 70 is ($., 6, "reading of one line adds +1 to current line number \$.");
455ece5e
AD
71}
72
a55c21fc 73is($., $curline, "the 'local' correctly restores old value of filehandler for \$. when goes out of scope");
455ece5e
AD
74
75{
76 local($.);
77
3fb41248 78 scalar <OTHER>;
a55c21fc 79 is($., 7, "reading of one line inside 'local' change filehandler for \$.");
455ece5e
AD
80}
81
a55c21fc 82is($., $curline, "the 'local' correctly restores old value of filehandler for \$. when goes out of scope");
455ece5e
AD
83
84{
85 local($.);
86
3fb41248 87 tell OTHER;
a55c21fc 88 is($., 7, "tell() inside 'local' change filehandler for \$.");
455ece5e 89}
d26ab924 90
3fb41248
SP
91close(OTHER);
92{
93 no warnings 'closed';
a55c21fc 94 is(tell(OTHER), -1, "tell() for closed file returns -1");
3fb41248
SP
95}
96{
97 no warnings 'unopened';
d8210736
TC
98 # this must be a handle that has never been opened
99 is(tell(UNOPENED), -1, "tell() for unopened file returns -1");
3fb41248 100}
d26ab924
JH
101
102# ftell(STDIN) (or any std streams) is undefined, it can return -1 or
103# something else. ftell() on pipes, fifos, and sockets is defined to
104# return -1.
105
62a28c97 106my $written = tempfile();
0678cb22 107
3fb41248 108close($TST);
0678cb22 109open($tst,">$written") || die "Cannot open $written:$!";
7bdbfeb7 110binmode $tst if $Is_Dosish;
0678cb22 111
a55c21fc 112is(tell($tst), 0, "tell() for new file returns 0");
0678cb22
NIS
113
114print $tst "fred\n";
115
a55c21fc 116is(tell($tst), 5, 'tell() after writing "fred\n" returns 5');
0678cb22
NIS
117
118print $tst "more\n";
119
a55c21fc 120is(tell($tst), 10, 'tell() after writing "more\n" returns 10');
0678cb22
NIS
121
122close($tst);
123
124open($tst,"+>>$written") || die "Cannot open $written:$!";
7bdbfeb7 125binmode $tst if $Is_Dosish;
0678cb22
NIS
126
127if (0)
128{
129 # :stdio does not pass these so ignore them for now
130
a55c21fc 131is(tell($tst), 0, 'tell() for open mode "+>>" returns 0');
0678cb22
NIS
132
133$line = <$tst>;
134
a55c21fc 135is($line, "fred\n", 'check first line in mode "+>>"');
0678cb22 136
a55c21fc 137is(tell($tst), 5, "check tell() afrer reading first line");
0678cb22
NIS
138
139}
140
141print $tst "xxxx\n";
142
a55c21fc
DU
143ok( tell($tst) == 15 ||
144 tell($tst) == 5,
145 'check tell() after writing "xxxx\n"'); # unset PERLIO or PERLIO=stdio (e.g. HP-UX, Solaris)
0678cb22
NIS
146
147close($tst);
148
c2fcde81
JH
149open($tst,">$written") || die "Cannot open $written:$!";
150print $tst "foobar";
151close $tst;
152open($tst,">>$written") || die "Cannot open $written:$!";
153
e4fdb327
YST
154# This test makes a questionable assumption that the file pointer will
155# be at eof after opening a file but before seeking, reading, or writing.
28f66490
PG
156# The POSIX standard is vague on this point.
157# Cygwin and VOS differ from other implementations.
158
159if (tell ($tst) == 6) {
a55c21fc 160 pass("check tell() after writing in mode '>>'");
28f66490
PG
161}
162else {
163 if (($^O eq "cygwin") && (&PerlIO::get_layers($tst) eq 'stdio')) {
a55c21fc 164 fail "# TODO: file pointer not at eof";
28f66490
PG
165 }
166 elsif ($^O eq "vos") {
a55c21fc 167 fail "# TODO: Hit bug posix-2056. file pointer not at eof";
28f66490
PG
168 }
169 else {
a55c21fc 170 fail "file pointer not at eof";
28f66490
PG
171 }
172}
e4fdb327 173
c2fcde81 174close $tst;
0678cb22 175
8dc99089
FC
176open FH, "test.pl";
177$fh = *FH; # coercible glob
a55c21fc
DU
178is(tell($fh), 0, "tell on coercible glob");
179is(tell, 0, "argless tell after tell \$coercible");
8dc99089 180tell *$fh;
a55c21fc 181is(tell, 0, "argless tell after tell *\$coercible");
3500db16 182eof $fh;
a55c21fc 183is(tell, 0, "argless tell after eof \$coercible");
3500db16 184eof *$fh;
a55c21fc 185is(tell, 0, "argless tell after eof *\$coercible");
423e8af5 186seek $fh,0,0;
a55c21fc 187is(tell, 0, "argless tell after seek \$coercible...");
423e8af5 188seek *$fh,0,0;
a55c21fc 189is(tell, 0, "argless tell after seek *\$coercible...");
b4e880f3
TC
190
191{
b4e880f3
TC
192 # [perl #133721]
193 fresh_perl_is(<<'EOI', 'ok', {}, 'eof with no ${^LAST_FH}');
194print "ok" if eof;
195EOI
196}