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