perldelta for 125ddee8ebdb, 2e51033c15c9
[perl.git] / t / op / sysio.t
1 #!./perl
2
3 BEGIN {
4   chdir 't' if -d 't';
5   require './test.pl';
6   set_up_inc('../lib');
7 }
8
9 plan tests => 45;
10
11 open(I, 'op/sysio.t') || die "sysio.t: cannot find myself: $!";
12 binmode 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
23 eval { sysread(I, $x, -1) };
24 like($@, qr/^Negative length /);
25
26 # $x should be intact
27 is($x, 'abc');
28
29 # should not be able to read before the buffer
30 eval { sysread(I, $x, 1, -4) };
31 like($@, qr/^Offset outside string /);
32
33 # $x should be intact
34 is($x, 'abc');
35
36 $a ='0123456789';
37
38 # default offset 0
39 is(sysread(I, $a, 3), 3);
40
41 # $a should be as follows
42 is($a, '#!.');
43
44 # reading past the buffer should zero pad
45 is(sysread(I, $a, 2, 5), 2);
46
47 # the zero pad should be seen now
48 is($a, "#!.\0\0/p");
49
50 # try changing the last two characters of $a
51 is(sysread(I, $a, 3, -2), 3);
52
53 # the last two characters of $a should have changed (into three)
54 is($a, "#!.\0\0erl");
55
56 $outfile = tempfile();
57
58 open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
59 binmode O;
60
61 select(O); $|=1; select(STDOUT);
62
63 # cannot write negative lengths
64 eval { syswrite(O, $x, -1) };
65 like($@, qr/^Negative length /);
66
67 # $x still intact
68 is($x, 'abc');
69
70 # $outfile still intact
71 ok(!-s $outfile);
72
73 # should not be able to write from after the buffer
74 eval { syswrite(O, $x, 1, 4) };
75 like($@, qr/^Offset outside string /);
76
77 # $x still intact
78 is($x, 'abc');
79
80 # but it should be ok to write from the end of the buffer
81 syswrite(O, $x, 0, 3);
82 syswrite(O, $x, 1, 3);
83
84 # $outfile still intact
85 if ($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 }
89 ok(!-s $outfile);
90
91 # should not be able to write from before the buffer
92
93 eval { syswrite(O, $x, 1, -4) };
94 like($@, qr/^Offset outside string /);
95
96 # $x still intact
97 is($x, 'abc');
98
99 # $outfile still intact
100 if ($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 }
104 ok(!-s $outfile);
105
106 # [perl #67912] syswrite prints garbage if called with empty scalar and non-zero offset
107 eval { my $buf = ''; syswrite(O, $buf, 1, 1) };
108 like($@, qr/^Offset outside string /);
109
110 # $x still intact
111 is($x, 'abc');
112
113 # $outfile still intact
114 if ($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 }
118 ok(!-s $outfile);
119
120 eval { my $buf = 'x'; syswrite(O, $buf, 1, 2) };
121 like($@, qr/^Offset outside string /);
122
123 # $x still intact
124 is($x, 'abc');
125
126 # $outfile still intact
127 if ($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 }
131 ok(!-s $outfile);
132
133 # default offset 0
134 if (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
145 is($a, "#!.\0\0erl");
146
147 # $outfile should have grown now
148 if ($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 }
152 is(-s $outfile, 2);
153
154 # with offset
155 is(syswrite(O, $a, 2, 5), 2);
156
157 # $a still intact
158 is($a, "#!.\0\0erl");
159
160 # $outfile should have grown now
161 if ($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 }
165 is(-s $outfile, 4);
166
167 # with negative offset and a bit too much length
168 is(syswrite(O, $a, 5, -3), 3);
169
170 # $a still intact
171 is($a, "#!.\0\0erl");
172
173 # $outfile should have grown now
174 if ($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 }
178 is(-s $outfile, 7);
179
180 # with implicit length argument
181 is(syswrite(O, $x), 3);
182
183 # $a still intact
184 is($x, "abc");
185
186 # $outfile should have grown now
187 if ($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 }
191 is(-s $outfile, 10);
192
193 close(O);
194
195 open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
196 binmode I;
197
198 $b = 'xyz';
199
200 # reading too much only return as much as available
201 is(sysread(I, $b, 100), 10);
202
203 # this we should have
204 is($b, '#!ererlabc');
205
206 # test sysseek
207
208 is(sysseek(I, 2, 0), 2);
209 sysread(I, $b, 3);
210 is($b, 'ere');
211
212 is(sysseek(I, -2, 1), 3);
213 sysread(I, $b, 4);
214 is($b, 'rerl');
215
216 ok(sysseek(I, 0, 0) eq '0 but true');
217
218 ok(not defined sysseek(I, -1, 1));
219
220 close(I);
221
222 unlink_all $outfile;
223
224 chdir('..');
225
226 1;
227
228 # eof