Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / sysio.t
CommitLineData
bbce6d69 1#!./perl
2
6aa2f6a7 3print "1..42\n";
bbce6d69 4
bfb65faf 5chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
6aa2f6a7 6@INC = '../../lib';
bbce6d69 7
8open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
9
502257bb 10$reopen = ($^O eq 'VMS' ||
11 $^O eq 'os2' ||
12 $^O eq 'MSWin32' ||
13 $^O eq 'NetWare' ||
14 $^O eq 'dos' ||
57af3f31 15 $^O eq 'mpeix');
9fcfb7d3 16
bbce6d69 17$x = 'abc';
18
19# should not be able to do negative lengths
20eval { sysread(I, $x, -1) };
21print 'not ' unless ($@ =~ /^Negative length /);
22print "ok 1\n";
23
24# $x should be intact
25print 'not ' unless ($x eq 'abc');
26print "ok 2\n";
27
28# should not be able to read before the buffer
29eval { sysread(I, $x, 1, -4) };
30print 'not ' unless ($x eq 'abc');
31print "ok 3\n";
32
33# $x should be intact
34print 'not ' unless ($x eq 'abc');
35print "ok 4\n";
36
37$a ='0123456789';
38
39# default offset 0
40print 'not ' unless(sysread(I, $a, 3) == 3);
41print "ok 5\n";
42
43# $a should be as follows
44print 'not ' unless ($a eq '#!.');
45print "ok 6\n";
46
47# reading past the buffer should zero pad
48print 'not ' unless(sysread(I, $a, 2, 5) == 2);
49print "ok 7\n";
50
51# the zero pad should be seen now
52print 'not ' unless ($a eq "#!.\0\0/p");
53print "ok 8\n";
54
55# try changing the last two characters of $a
56print 'not ' unless(sysread(I, $a, 3, -2) == 3);
57print "ok 9\n";
58
59# the last two characters of $a should have changed (into three)
60print 'not ' unless ($a eq "#!.\0\0erl");
61print "ok 10\n";
62
63$outfile = 'sysio.out';
64
65open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
66
67select(O); $|=1; select(STDOUT);
68
69# cannot write negative lengths
70eval { syswrite(O, $x, -1) };
71print 'not ' unless ($@ =~ /^Negative length /);
72print "ok 11\n";
73
74# $x still intact
75print 'not ' unless ($x eq 'abc');
76print "ok 12\n";
77
78# $outfile still intact
79print 'not ' if (-s $outfile);
80print "ok 13\n";
81
82# should not be able to write from after the buffer
83eval { syswrite(O, $x, 1, 3) };
84print 'not ' unless ($@ =~ /^Offset outside string /);
85print "ok 14\n";
86
87# $x still intact
88print 'not ' unless ($x eq 'abc');
89print "ok 15\n";
90
91# $outfile still intact
9fcfb7d3 92if ($reopen) { # must close file to update EOF marker for stat
93 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
94}
bbce6d69 95print 'not ' if (-s $outfile);
96print "ok 16\n";
97
98# should not be able to write from before the buffer
99
100eval { syswrite(O, $x, 1, -4) };
101print 'not ' unless ($@ =~ /^Offset outside string /);
102print "ok 17\n";
103
104# $x still intact
105print 'not ' unless ($x eq 'abc');
106print "ok 18\n";
107
108# $outfile still intact
9fcfb7d3 109if ($reopen) { # must close file to update EOF marker for stat
110 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
111}
bbce6d69 112print 'not ' if (-s $outfile);
113print "ok 19\n";
114
115# default offset 0
502257bb 116if (syswrite(O, $a, 2) == 2){
117 print "ok 20\n";
118} else {
119 print "# $!\nnot ok 20\n";
120 # most other tests make no sense after e.g. "No space left on device"
121 die $!;
122}
123
bbce6d69 124
125# $a still intact
126print 'not ' unless ($a eq "#!.\0\0erl");
127print "ok 21\n";
128
129# $outfile should have grown now
9fcfb7d3 130if ($reopen) { # must close file to update EOF marker for stat
131 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
132}
bbce6d69 133print 'not ' unless (-s $outfile == 2);
134print "ok 22\n";
135
136# with offset
137print 'not ' unless (syswrite(O, $a, 2, 5) == 2);
138print "ok 23\n";
139
140# $a still intact
141print 'not ' unless ($a eq "#!.\0\0erl");
142print "ok 24\n";
143
144# $outfile should have grown now
9fcfb7d3 145if ($reopen) { # must close file to update EOF marker for stat
146 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
147}
bbce6d69 148print 'not ' unless (-s $outfile == 4);
149print "ok 25\n";
150
151# with negative offset and a bit too much length
152print 'not ' unless (syswrite(O, $a, 5, -3) == 3);
153print "ok 26\n";
154
155# $a still intact
156print 'not ' unless ($a eq "#!.\0\0erl");
157print "ok 27\n";
158
159# $outfile should have grown now
9fcfb7d3 160if ($reopen) { # must close file to update EOF marker for stat
161 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
162}
bbce6d69 163print 'not ' unless (-s $outfile == 7);
164print "ok 28\n";
165
b56ec344 166# with implicit length argument
167print 'not ' unless (syswrite(O, $x) == 3);
168print "ok 29\n";
169
170# $a still intact
171print 'not ' unless ($x eq "abc");
172print "ok 30\n";
173
174# $outfile should have grown now
175if ($reopen) { # must close file to update EOF marker for stat
176 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
177}
178print 'not ' unless (-s $outfile == 10);
179print "ok 31\n";
180
bbce6d69 181close(O);
182
183open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
184
185$b = 'xyz';
186
187# reading too much only return as much as available
b56ec344 188print 'not ' unless (sysread(I, $b, 100) == 10);
189print "ok 32\n";
bbce6d69 190# this we should have
b56ec344 191print 'not ' unless ($b eq '#!ererlabc');
192print "ok 33\n";
bbce6d69 193
8903cb82 194# test sysseek
137443ea 195
8903cb82 196print 'not ' unless sysseek(I, 2, 0) == 2;
b56ec344 197print "ok 34\n";
137443ea 198sysread(I, $b, 3);
199print 'not ' unless $b eq 'ere';
b56ec344 200print "ok 35\n";
137443ea 201
8903cb82 202print 'not ' unless sysseek(I, -2, 1) == 3;
b56ec344 203print "ok 36\n";
137443ea 204sysread(I, $b, 4);
205print 'not ' unless $b eq 'rerl';
b56ec344 206print "ok 37\n";
137443ea 207
8903cb82 208print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
b56ec344 209print "ok 38\n";
8903cb82 210print 'not ' if defined sysseek(I, -1, 1);
b56ec344 211print "ok 39\n";
8903cb82 212
bbce6d69 213close(I);
214
215unlink $outfile;
216
6aa2f6a7 217# Check that utf8 IO doesn't upgrade the scalar
218open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
219# Will skip harmlessly on stdioperl
220eval {binmode STDOUT, ":utf8"};
221die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/;
222
223# y diaresis is \w when UTF8
224$a = chr 255;
225
226print $a =~ /\w/ ? "not ok 40\n" : "ok 40\n";
227
228syswrite I, $a;
229
230# Should not be upgraded as a side effect of syswrite.
231print $a =~ /\w/ ? "not ok 41\n" : "ok 41\n";
232
233# This should work
234eval {syswrite I, 2;};
235print $@ eq "" ? "ok 42\n" : "not ok 42 # $@";
236
237close(I);
238unlink $outfile;
239
502257bb 240chdir('..');
8ebc5c01 241
bbce6d69 2421;
243
244# eof