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