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
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 require './test.pl';
6 set_up_inc('../lib');
7}
8
9plan(36);
10
11$TST = 'TST';
12
13$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'dos' or
14 $^O eq 'os2' or $^O eq 'cygwin' or
15 $^O =~ /^uwin/);
16
17open($TST, 'harness') || (die "Can't open harness");
18binmode $TST if $Is_Dosish;
19ok(!eof(TST), "eof is false after open() non-empty file");
20
21$firstline = <$TST>;
22$secondpos = tell;
23
24$x = 0;
25while (<TST>) {
26 if (eof) {$x++;}
27}
28is($x, 1, "only one eof is in the file");
29
30$lastpos = tell;
31
32ok(eof, "tell() doesn't change current state of eof");
33
34ok(seek($TST,0,0), "set current position at beginning of the file");
35
36ok(!eof, "reset at beginning of file clears eof flag");
37
38is($firstline, <TST>, "first line is the same after open() and after seek()");
39
40is($secondpos, tell, "position is the same after reading the first line");
41
42ok(seek(TST,0,1), "move current position on +0");
43
44ok(!eof($TST), "it doesn't set eof flag");
45
46is($secondpos, tell, "it doesn't change tell position");
47
48ok(seek(TST,0,2), "move current position at the end of the file");
49
50is($lastpos, tell, "the position is the same as after reading whole file line by line");
51
52ok(eof, "it sets eof flag");
53
54ok($., "current line number \$. is not null");
55
56$curline = $.;
57open(OTHER, 'harness') || (die "Can't open harness: $!");
58binmode OTHER if (($^O eq 'MSWin32') || ($^O eq 'NetWare'));
59
60{
61 local($.);
62
63 ok($., "open() doesn't change filehandler for \$.");
64
65 tell OTHER;
66 ok(!$., "tell() does change filehandler for \$.");
67
68 $. = 5;
69 scalar <OTHER>;
70 is ($., 6, "reading of one line adds +1 to current line number \$.");
71}
72
73is($., $curline, "the 'local' correctly restores old value of filehandler for \$. when goes out of scope");
74
75{
76 local($.);
77
78 scalar <OTHER>;
79 is($., 7, "reading of one line inside 'local' change filehandler for \$.");
80}
81
82is($., $curline, "the 'local' correctly restores old value of filehandler for \$. when goes out of scope");
83
84{
85 local($.);
86
87 tell OTHER;
88 is($., 7, "tell() inside 'local' change filehandler for \$.");
89}
90
91close(OTHER);
92{
93 no warnings 'closed';
94 is(tell(OTHER), -1, "tell() for closed file returns -1");
95}
96{
97 no warnings 'unopened';
98 # this must be a handle that has never been opened
99 is(tell(UNOPENED), -1, "tell() for unopened file returns -1");
100}
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
106my $written = tempfile();
107
108close($TST);
109open($tst,">$written") || die "Cannot open $written:$!";
110binmode $tst if $Is_Dosish;
111
112is(tell($tst), 0, "tell() for new file returns 0");
113
114print $tst "fred\n";
115
116is(tell($tst), 5, 'tell() after writing "fred\n" returns 5');
117
118print $tst "more\n";
119
120is(tell($tst), 10, 'tell() after writing "more\n" returns 10');
121
122close($tst);
123
124open($tst,"+>>$written") || die "Cannot open $written:$!";
125binmode $tst if $Is_Dosish;
126
127if (0)
128{
129 # :stdio does not pass these so ignore them for now
130
131is(tell($tst), 0, 'tell() for open mode "+>>" returns 0');
132
133$line = <$tst>;
134
135is($line, "fred\n", 'check first line in mode "+>>"');
136
137is(tell($tst), 5, "check tell() afrer reading first line");
138
139}
140
141print $tst "xxxx\n";
142
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)
146
147close($tst);
148
149open($tst,">$written") || die "Cannot open $written:$!";
150print $tst "foobar";
151close $tst;
152open($tst,">>$written") || die "Cannot open $written:$!";
153
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.
156# The POSIX standard is vague on this point.
157# Cygwin and VOS differ from other implementations.
158
159if (tell ($tst) == 6) {
160 pass("check tell() after writing in mode '>>'");
161}
162else {
163 if (($^O eq "cygwin") && (&PerlIO::get_layers($tst) eq 'stdio')) {
164 fail "# TODO: file pointer not at eof";
165 }
166 elsif ($^O eq "vos") {
167 fail "# TODO: Hit bug posix-2056. file pointer not at eof";
168 }
169 else {
170 fail "file pointer not at eof";
171 }
172}
173
174close $tst;
175
176open FH, "test.pl";
177$fh = *FH; # coercible glob
178is(tell($fh), 0, "tell on coercible glob");
179is(tell, 0, "argless tell after tell \$coercible");
180tell *$fh;
181is(tell, 0, "argless tell after tell *\$coercible");
182eof $fh;
183is(tell, 0, "argless tell after eof \$coercible");
184eof *$fh;
185is(tell, 0, "argless tell after eof *\$coercible");
186seek $fh,0,0;
187is(tell, 0, "argless tell after seek \$coercible...");
188seek *$fh,0,0;
189is(tell, 0, "argless tell after seek *\$coercible...");
190
191{
192 # [perl #133721]
193 fresh_perl_is(<<'EOI', 'ok', {}, 'eof with no ${^LAST_FH}');
194print "ok" if eof;
195EOI
196}