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