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