Commit | Line | Data |
---|---|---|
bbce6d69 | 1 | #!./perl |
2 | ||
3 | print "1..30\n"; | |
4 | ||
5 | chdir('op') || die "sysio.t: cannot look for myself: $!"; | |
6 | ||
7 | open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!"; | |
8 | ||
9fcfb7d3 CB |
9 | $reopen = ($^O eq 'VMS' || $^O eq 'os2'); |
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 | ||
167 | close(I); | |
168 | ||
169 | unlink $outfile; | |
170 | ||
171 | 1; | |
172 | ||
173 | # eof |