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