t/io/tell.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 print "1..35\n";
  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 if (eof(TST)) { print "not ok 1\n"; } else { print "ok 1\n"; }
  20
  21 $firstline = <$TST>;
  22 $secondpos = tell;
  23
  24 $x = 0;
  25 while (<TST>) {
  26     if (eof) {$x++;}
  27 }
  28 if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
  29
  30 $lastpos = tell;
  31
  32 unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
  33
  34 if (seek($TST,0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
  35
  36 if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
  37
  38 if ($firstline eq <TST>) { print "ok 6\n"; } else { print "not ok 6\n"; }
  39
  40 if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
  41
  42 if (seek(TST,0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
  43
  44 if (eof($TST)) { print "not ok 9\n"; } else { print "ok 9\n"; }
  45
  46 if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
  47
  48 if (seek(TST,0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
  49
  50 if ($lastpos == tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
  51
  52 unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }
  53
  54 if ($. == 0) { print "not ok 14\n"; } else { print "ok 14\n"; }
  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     if ($. == 0) { print "not ok 15\n"; } else { print "ok 15\n"; }
  64
  65     tell OTHER;
  66     if ($. == 0) { print "ok 16\n"; } else { print "not ok 16\n"; }
  67
  68     $. = 5;
  69     scalar <OTHER>;
  70     if ($. == 6) { print "ok 17\n"; } else { print "not ok 17\n"; }
  71 }
  72
  73 if ($. == $curline) { print "ok 18\n"; } else { print "not ok 18\n"; }
  74
  75 {
  76     local($.);
  77
  78     scalar <OTHER>;
  79     if ($. == 7) { print "ok 19\n"; } else { print "not ok 19\n"; }
  80 }
  81
  82 if ($. == $curline) { print "ok 20\n"; } else { print "not ok 20\n"; }
  83
  84 {
  85     local($.);
  86
  87     tell OTHER;
  88     if ($. == 7) { print "ok 21\n"; } else { print "not ok 21\n"; }
  89 }
  90
  91 close(OTHER);
  92 {
  93     no warnings 'closed';
  94     if (tell(OTHER) == -1)  { print "ok 22\n"; } else { print "not ok 22\n"; }
  95 }
  96 {
  97     no warnings 'unopened';
  98     if (tell(ETHER) == -1)  { print "ok 23\n"; } else { print "not ok 23\n"; }
  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 if (tell($tst) == 0) { print "ok 24\n"; } else { print "not ok 24\n"; }
 112
 113 print $tst "fred\n";
 114
 115 if (tell($tst) == 5) { print "ok 25\n"; } else { print "not ok 25\n"; }
 116
 117 print $tst "more\n";
 118
 119 if (tell($tst) == 10) { print "ok 26\n"; } else { print "not ok 26\n"; }
 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 if (tell($tst) == 0) { print "ok 27\n"; } else { print "not ok 27\n"; }
 131
 132 $line = <$tst>;
 133
 134 if ($line eq "fred\n") { print "ok 29\n"; } else { print "not ok 29\n"; }
 135
 136 if (tell($tst) == 5) { print "ok 30\n"; } else { print "not ok 30\n"; }
 137
 138 }
 139
 140 print $tst "xxxx\n";
 141
 142 if (tell($tst) == 15 ||
 143     tell($tst) == 5) # unset PERLIO or PERLIO=stdio (e.g. HP-UX, Solaris)
 144 { print "ok 27\n"; } else { print "not ok 27\n"; }
 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 # Only known failure is on cygwin.
 156 my $todo = $^O eq "cygwin" && &PerlIO::get_layers($tst) eq 'stdio'
 157     && ' # TODO: file pointer not at eof';
 158
 159 if (tell($tst) == 6)
 160 { print "ok 28$todo\n"; } else { print "not ok 28$todo\n"; }
 161 close $tst;
 162
 163 open FH, "test.pl";
 164 $fh = *FH; # coercible glob
 165 $not = "not " x! (tell $fh == 0);
 166 print "${not}ok 29 - tell on coercible glob\n";
 167 $not = "not " x! (tell == 0);
 168 print "${not}ok 30 - argless tell after tell \$coercible\n";
 169 tell *$fh;
 170 $not = "not " x! (tell == 0);
 171 print "${not}ok 31 - argless tell after tell *\$coercible\n";
 172 eof $fh;
 173 $not = "not " x! (tell == 0);
 174 print "${not}ok 32 - argless tell after eof \$coercible\n";
 175 eof *$fh;
 176 $not = "not " x! (tell == 0);
 177 print "${not}ok 33 - argless tell after eof *\$coercible\n";
 178 seek $fh,0,0;
 179 $not = "not " x! (tell == 0);
 180 print "${not}ok 34 - argless tell after seek \$coercible...\n";
 181 seek *$fh,0,0;
 182 $not = "not " x! (tell == 0);
 183 print "${not}ok 35 - argless tell after seek *\$coercible...\n";