Commit | Line | Data |
---|---|---|
bbce6d69 | 1 | #!./perl |
2 | ||
dfeca2c8 VP |
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 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 | |
73 | eval { syswrite(O, $x, 1, 3) }; | |
dfeca2c8 | 74 | like($@, qr/^Offset outside string /); |
bbce6d69 | 75 | |
76 | # $x still intact | |
dfeca2c8 | 77 | is($x, 'abc'); |
bbce6d69 | 78 | |
79 | # $outfile still intact | |
9fcfb7d3 CB |
80 | if ($reopen) { # must close file to update EOF marker for stat |
81 | close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
82 | } | |
dfeca2c8 | 83 | ok(!-s $outfile); |
bbce6d69 | 84 | |
85 | # should not be able to write from before the buffer | |
86 | ||
87 | eval { syswrite(O, $x, 1, -4) }; | |
dfeca2c8 VP |
88 | like($@, qr/^Offset outside string /); |
89 | ||
90 | # $x still intact | |
91 | is($x, 'abc'); | |
92 | ||
93 | # $outfile still intact | |
94 | if ($reopen) { # must close file to update EOF marker for stat | |
95 | close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
96 | } | |
97 | ok(!-s $outfile); | |
98 | ||
99 | # [perl #67912] syswrite prints garbage if called with empty scalar and non-zero offset | |
100 | eval { my $buf = ''; syswrite(O, $buf, 1, 0) }; | |
101 | like($@, qr/^Offset outside string /); | |
bbce6d69 | 102 | |
103 | # $x still intact | |
dfeca2c8 | 104 | is($x, 'abc'); |
bbce6d69 | 105 | |
106 | # $outfile still intact | |
9fcfb7d3 CB |
107 | if ($reopen) { # must close file to update EOF marker for stat |
108 | close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
109 | } | |
dfeca2c8 VP |
110 | ok(!-s $outfile); |
111 | ||
112 | eval { my $buf = 'x'; syswrite(O, $buf, 1, 1) }; | |
113 | like($@, qr/^Offset outside string /); | |
114 | ||
115 | # $x still intact | |
116 | is($x, 'abc'); | |
117 | ||
118 | # $outfile still intact | |
119 | if ($reopen) { # must close file to update EOF marker for stat | |
120 | close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
121 | } | |
122 | ok(!-s $outfile); | |
bbce6d69 | 123 | |
124 | # default offset 0 | |
502257bb | 125 | if (syswrite(O, $a, 2) == 2){ |
dfeca2c8 | 126 | pass(); |
502257bb | 127 | } else { |
dfeca2c8 VP |
128 | diag($!); |
129 | fail(); | |
502257bb A |
130 | # most other tests make no sense after e.g. "No space left on device" |
131 | die $!; | |
132 | } | |
133 | ||
bbce6d69 | 134 | |
135 | # $a still intact | |
dfeca2c8 | 136 | is($a, "#!.\0\0erl"); |
bbce6d69 | 137 | |
138 | # $outfile should have grown now | |
9fcfb7d3 CB |
139 | if ($reopen) { # must close file to update EOF marker for stat |
140 | close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
141 | } | |
dfeca2c8 | 142 | is(-s $outfile, 2); |
bbce6d69 | 143 | |
144 | # with offset | |
dfeca2c8 | 145 | is(syswrite(O, $a, 2, 5), 2); |
bbce6d69 | 146 | |
147 | # $a still intact | |
dfeca2c8 | 148 | is($a, "#!.\0\0erl"); |
bbce6d69 | 149 | |
150 | # $outfile should have grown now | |
9fcfb7d3 CB |
151 | if ($reopen) { # must close file to update EOF marker for stat |
152 | close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
153 | } | |
dfeca2c8 | 154 | is(-s $outfile, 4); |
bbce6d69 | 155 | |
156 | # with negative offset and a bit too much length | |
dfeca2c8 | 157 | is(syswrite(O, $a, 5, -3), 3); |
bbce6d69 | 158 | |
159 | # $a still intact | |
dfeca2c8 | 160 | is($a, "#!.\0\0erl"); |
bbce6d69 | 161 | |
162 | # $outfile should have grown now | |
9fcfb7d3 CB |
163 | if ($reopen) { # must close file to update EOF marker for stat |
164 | close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
165 | } | |
dfeca2c8 | 166 | is(-s $outfile, 7); |
bbce6d69 | 167 | |
b56ec344 | 168 | # with implicit length argument |
dfeca2c8 | 169 | is(syswrite(O, $x), 3); |
b56ec344 JH |
170 | |
171 | # $a still intact | |
dfeca2c8 | 172 | is($x, "abc"); |
b56ec344 JH |
173 | |
174 | # $outfile should have grown now | |
175 | if ($reopen) { # must close file to update EOF marker for stat | |
176 | close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
177 | } | |
dfeca2c8 VP |
178 | is(-s $outfile, 10); |
179 | ||
180 | close(O); | |
b56ec344 | 181 | |
bbce6d69 | 182 | open(I, $outfile) || die "sysio.t: cannot read $outfile: $!"; |
183 | ||
184 | $b = 'xyz'; | |
185 | ||
186 | # reading too much only return as much as available | |
dfeca2c8 VP |
187 | is(sysread(I, $b, 100), 10); |
188 | ||
bbce6d69 | 189 | # this we should have |
dfeca2c8 | 190 | is($b, '#!ererlabc'); |
bbce6d69 | 191 | |
8903cb82 | 192 | # test sysseek |
137443ea | 193 | |
dfeca2c8 | 194 | is(sysseek(I, 2, 0), 2); |
137443ea | 195 | sysread(I, $b, 3); |
dfeca2c8 | 196 | is($b, 'ere'); |
137443ea | 197 | |
dfeca2c8 | 198 | is(sysseek(I, -2, 1), 3); |
137443ea | 199 | sysread(I, $b, 4); |
dfeca2c8 VP |
200 | is($b, 'rerl'); |
201 | ||
202 | ok(sysseek(I, 0, 0) eq '0 but true'); | |
137443ea | 203 | |
dfeca2c8 | 204 | ok(not defined sysseek(I, -1, 1)); |
8903cb82 | 205 | |
bbce6d69 | 206 | close(I); |
207 | ||
208 | unlink $outfile; | |
209 | ||
6aa2f6a7 NC |
210 | # Check that utf8 IO doesn't upgrade the scalar |
211 | open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!"; | |
212 | # Will skip harmlessly on stdioperl | |
213 | eval {binmode STDOUT, ":utf8"}; | |
214 | die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/; | |
215 | ||
216 | # y diaresis is \w when UTF8 | |
217 | $a = chr 255; | |
218 | ||
dfeca2c8 | 219 | unlike($a, qr/\w/); |
6aa2f6a7 NC |
220 | |
221 | syswrite I, $a; | |
222 | ||
223 | # Should not be upgraded as a side effect of syswrite. | |
dfeca2c8 | 224 | unlike($a, qr/\w/); |
6aa2f6a7 NC |
225 | |
226 | # This should work | |
227 | eval {syswrite I, 2;}; | |
dfeca2c8 | 228 | is($@, ''); |
6aa2f6a7 NC |
229 | |
230 | close(I); | |
231 | unlink $outfile; | |
232 | ||
502257bb | 233 | chdir('..'); |
8ebc5c01 | 234 | |
bbce6d69 | 235 | 1; |
236 | ||
237 | # eof |