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
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 plan(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
17 open($TST, 'harness') || (die "Can't open harness");
18 binmode $TST if $Is_Dosish;
19 ok(!eof(TST), "eof is false after open() non-empty file");
20
21 $firstline = <$TST>;
22 $secondpos = tell;
23
24 $x = 0;
25 while (<TST>) {
26     if (eof) {$x++;}
27 }
28 is($x, 1, "only one eof is in the file");
29
30 $lastpos = tell;
31
32 ok(eof, "tell() doesn't change current state of eof");
33
34 ok(seek($TST,0,0), "set current position at beginning of the file");
35
36 ok(!eof, "reset at beginning of file clears eof flag");
37
38 is($firstline, <TST>, "first line is the same after open() and after seek()");
39
40 is($secondpos, tell, "position is the same after reading the first line");
41
42 ok(seek(TST,0,1), "move current position on +0");
43
44 ok(!eof($TST), "it doesn't set eof flag");
45
46 is($secondpos, tell, "it doesn't change tell position");
47
48 ok(seek(TST,0,2), "move current position at the end of the file");
49
50 is($lastpos, tell, "the position is the same as after reading whole file line by line");
51
52 ok(eof, "it sets eof flag");
53
54 ok($., "current line number \$. is not null");
55
56 $curline = $.;
57 open(OTHER, 'harness') || (die "Can't open harness: $!");
58 binmode 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
73 is($., $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
82 is($., $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
91 close(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
106 my $written = tempfile();
107
108 close($TST);
109 open($tst,">$written")  || die "Cannot open $written:$!";
110 binmode $tst if $Is_Dosish;
111
112 is(tell($tst), 0, "tell() for new file returns 0");
113
114 print $tst "fred\n";
115
116 is(tell($tst), 5, 'tell() after writing "fred\n" returns 5');
117
118 print $tst "more\n";
119
120 is(tell($tst), 10, 'tell() after writing "more\n" returns 10');
121
122 close($tst);
123
124 open($tst,"+>>$written")  || die "Cannot open $written:$!";
125 binmode $tst if $Is_Dosish;
126
127 if (0) 
128 {
129  # :stdio does not pass these so ignore them for now 
130
131 is(tell($tst), 0, 'tell() for open mode "+>>" returns 0');
132
133 $line = <$tst>;
134
135 is($line, "fred\n", 'check first line in mode "+>>"');
136
137 is(tell($tst), 5, "check tell() afrer reading first line");
138
139 }
140
141 print $tst "xxxx\n";
142
143 ok( 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
147 close($tst);
148
149 open($tst,">$written")  || die "Cannot open $written:$!";
150 print $tst "foobar";
151 close $tst;
152 open($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
159 if (tell ($tst) == 6) {
160   pass("check tell() after writing in mode '>>'");
161 }
162 else {
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
174 close $tst;
175
176 open FH, "test.pl";
177 $fh = *FH; # coercible glob
178 is(tell($fh), 0, "tell on coercible glob");
179 is(tell, 0, "argless tell after tell \$coercible");
180 tell *$fh;
181 is(tell, 0, "argless tell after tell *\$coercible");
182 eof $fh;
183 is(tell, 0, "argless tell after eof \$coercible");
184 eof *$fh;
185 is(tell, 0, "argless tell after eof *\$coercible");
186 seek $fh,0,0;
187 is(tell, 0, "argless tell after seek \$coercible...");
188 seek *$fh,0,0;
189 is(tell, 0, "argless tell after seek *\$coercible...");
190
191 {
192     # [perl #133721]
193     fresh_perl_is(<<'EOI', 'ok', {}, 'eof with no ${^LAST_FH}');
194 print "ok" if eof;
195 EOI
196 }