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