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