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