Commit | Line | Data |
---|---|---|
bbce6d69 | 1 | #!./perl |
2 | ||
dfeca2c8 | 3 | BEGIN { |
c2970a99 NC |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
dfeca2c8 | 7 | } |
bbce6d69 | 8 | |
dfeca2c8 | 9 | plan tests => 48; |
bbce6d69 | 10 | |
c2970a99 | 11 | open(I, 'op/sysio.t') || die "sysio.t: cannot find myself: $!"; |
bbce6d69 | 12 | |
502257bb A |
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 GA |
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 CB |
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 VP |
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 CB |
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 VP |
114 | ok(!-s $outfile); |
115 | ||
3c946528 | 116 | eval { my $buf = 'x'; syswrite(O, $buf, 1, 2) }; |
dfeca2c8 VP |
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 VP |
132 | diag($!); |
133 | fail(); | |
502257bb A |
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 CB |
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 CB |
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 CB |
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 JH |
174 | |
175 | # $a still intact | |
dfeca2c8 | 176 | is($x, "abc"); |
b56ec344 JH |
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 VP |
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 VP |
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 VP |
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 | ||
5fd6a578 | 212 | unlink_all $outfile; |
bbce6d69 | 213 | |
6aa2f6a7 NC |
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 NC |
224 | |
225 | syswrite I, $a; | |
226 | ||
227 | # Should not be upgraded as a side effect of syswrite. | |
dfeca2c8 | 228 | unlike($a, qr/\w/); |
6aa2f6a7 NC |
229 | |
230 | # This should work | |
231 | eval {syswrite I, 2;}; | |
dfeca2c8 | 232 | is($@, ''); |
6aa2f6a7 NC |
233 | |
234 | close(I); | |
5fd6a578 | 235 | unlink_all $outfile; |
6aa2f6a7 | 236 | |
502257bb | 237 | chdir('..'); |
8ebc5c01 | 238 | |
bbce6d69 | 239 | 1; |
240 | ||
241 | # eof |