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