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 CB |
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 CB |
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 CB |
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 CB |
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 CB |
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 |