S_del_body is sufficiently small that inlining it is a space win.
[p5sagit/p5-mst-13.2.git] / t / io / tell.t
CommitLineData
8d063cd8 1#!./perl
2
455ece5e 3# $RCSfile: tell.t,v $$Revision$$Date$
8d063cd8 4
58c59f01 5BEGIN {
6 chdir 't' if -d 't';
7 @INC = '../lib';
8}
9
c2fcde81 10print "1..28\n";
8d063cd8 11
378cc40b 12$TST = 'tst';
13
2986a63f 14$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'dos' or
cebd85e6 15 $^O eq 'os2' or $^O eq 'mint' or $^O eq 'cygwin' or
16 $^O =~ /^uwin/);
8736538c 17
2eb25c99 18open($TST, 'harness') || (die "Can't open harness");
8736538c 19binmode $TST if $Is_Dosish;
8d063cd8 20if (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; }
21
378cc40b 22$firstline = <$TST>;
8d063cd8 23$secondpos = tell;
24
25$x = 0;
26while (<tst>) {
27 if (eof) {$x++;}
28}
29if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
30
31$lastpos = tell;
32
33unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
34
378cc40b 35if (seek($TST,0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
8d063cd8 36
37if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
38
39if ($firstline eq <tst>) { print "ok 6\n"; } else { print "not ok 6\n"; }
40
41if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
42
43if (seek(tst,0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
44
378cc40b 45if (eof($TST)) { print "not ok 9\n"; } else { print "ok 9\n"; }
8d063cd8 46
47if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
48
49if (seek(tst,0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
50
51if ($lastpos == tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
52
53unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }
455ece5e 54
55if ($. == 0) { print "not ok 14\n"; } else { print "ok 14\n"; }
56
57$curline = $.;
2eb25c99 58open(other, 'harness') || (die "Can't open harness: $!");
2986a63f 59binmode other if (($^O eq 'MSWin32') || ($^O eq 'NetWare'));
455ece5e 60
61{
62 local($.);
63
64 if ($. == 0) { print "not ok 15\n"; } else { print "ok 15\n"; }
65
66 tell other;
67 if ($. == 0) { print "ok 16\n"; } else { print "not ok 16\n"; }
68
69 $. = 5;
70 scalar <other>;
71 if ($. == 6) { print "ok 17\n"; } else { print "not ok 17\n"; }
72}
73
74if ($. == $curline) { print "ok 18\n"; } else { print "not ok 18\n"; }
75
76{
77 local($.);
78
79 scalar <other>;
80 if ($. == 7) { print "ok 19\n"; } else { print "not ok 19\n"; }
81}
82
83if ($. == $curline) { print "ok 20\n"; } else { print "not ok 20\n"; }
84
85{
86 local($.);
87
88 tell other;
89 if ($. == 7) { print "ok 21\n"; } else { print "not ok 21\n"; }
90}
d26ab924 91
92close(other);
93if (tell(other) == -1) { print "ok 22\n"; } else { print "not ok 22\n"; }
94
95if (tell(ether) == -1) { print "ok 23\n"; } else { print "not ok 23\n"; }
96
97# ftell(STDIN) (or any std streams) is undefined, it can return -1 or
98# something else. ftell() on pipes, fifos, and sockets is defined to
99# return -1.
100
0678cb22 101my $written = "tell_write.txt";
102
4e7ee149 103END { 1 while unlink($written) }
0678cb22 104
105close($tst);
106open($tst,">$written") || die "Cannot open $written:$!";
7bdbfeb7 107binmode $tst if $Is_Dosish;
0678cb22 108
109if (tell($tst) == 0) { print "ok 24\n"; } else { print "not ok 24\n"; }
110
111print $tst "fred\n";
112
113if (tell($tst) == 5) { print "ok 25\n"; } else { print "not ok 25\n"; }
114
115print $tst "more\n";
116
117if (tell($tst) == 10) { print "ok 26\n"; } else { print "not ok 26\n"; }
118
119close($tst);
120
121open($tst,"+>>$written") || die "Cannot open $written:$!";
7bdbfeb7 122binmode $tst if $Is_Dosish;
0678cb22 123
124if (0)
125{
126 # :stdio does not pass these so ignore them for now
127
128if (tell($tst) == 0) { print "ok 27\n"; } else { print "not ok 27\n"; }
129
130$line = <$tst>;
131
132if ($line eq "fred\n") { print "ok 29\n"; } else { print "not ok 29\n"; }
133
134if (tell($tst) == 5) { print "ok 30\n"; } else { print "not ok 30\n"; }
135
136}
137
138print $tst "xxxx\n";
139
c6b46866 140if (tell($tst) == 15 ||
141 tell($tst) == 5) # unset PERLIO or PERLIO=stdio (e.g. HP-UX, Solaris)
142{ print "ok 27\n"; } else { print "not ok 27\n"; }
0678cb22 143
144close($tst);
145
c2fcde81 146open($tst,">$written") || die "Cannot open $written:$!";
147print $tst "foobar";
148close $tst;
149open($tst,">>$written") || die "Cannot open $written:$!";
150
e4fdb327 151# This test makes a questionable assumption that the file pointer will
152# be at eof after opening a file but before seeking, reading, or writing.
153# Only known failure is on cygwin.
92770387 154my $todo = $^O eq "cygwin" && &PerlIO::get_layers($tst) eq 'stdio'
155 && ' # TODO: file pointer not at eof';
e4fdb327 156
c2fcde81 157if (tell($tst) == 6)
92770387 158{ print "ok 28$todo\n"; } else { print "not ok 28$todo\n"; }
c2fcde81 159close $tst;
0678cb22 160