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