| 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 | } |