5 chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
9 open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
11 $reopen = ($^O eq 'VMS' ||
20 # should not be able to do negative lengths
21 eval { sysread(I, $x, -1) };
22 print 'not ' unless ($@ =~ /^Negative length /);
26 print 'not ' unless ($x eq 'abc');
29 # should not be able to read before the buffer
30 eval { sysread(I, $x, 1, -4) };
31 print 'not ' unless ($x eq 'abc');
35 print 'not ' unless ($x eq 'abc');
41 print 'not ' unless(sysread(I, $a, 3) == 3);
44 # $a should be as follows
45 print 'not ' unless ($a eq '#!.');
48 # reading past the buffer should zero pad
49 print 'not ' unless(sysread(I, $a, 2, 5) == 2);
52 # the zero pad should be seen now
53 print 'not ' unless ($a eq "#!.\0\0/p");
56 # try changing the last two characters of $a
57 print 'not ' unless(sysread(I, $a, 3, -2) == 3);
60 # the last two characters of $a should have changed (into three)
61 print 'not ' unless ($a eq "#!.\0\0erl");
64 $outfile = tempfile();
66 open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
68 select(O); $|=1; select(STDOUT);
70 # cannot write negative lengths
71 eval { syswrite(O, $x, -1) };
72 print 'not ' unless ($@ =~ /^Negative length /);
76 print 'not ' unless ($x eq 'abc');
79 # $outfile still intact
80 print 'not ' if (-s $outfile);
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 /);
89 print 'not ' unless ($x eq 'abc');
92 # $outfile still intact
93 if ($reopen) { # must close file to update EOF marker for stat
94 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
96 print 'not ' if (-s $outfile);
99 # should not be able to write from before the buffer
101 eval { syswrite(O, $x, 1, -4) };
102 print 'not ' unless ($@ =~ /^Offset outside string /);
106 print 'not ' unless ($x eq 'abc');
109 # $outfile still intact
110 if ($reopen) { # must close file to update EOF marker for stat
111 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
113 print 'not ' if (-s $outfile);
117 if (syswrite(O, $a, 2) == 2){
120 print "# $!\nnot ok 20\n";
121 # most other tests make no sense after e.g. "No space left on device"
127 print 'not ' unless ($a eq "#!.\0\0erl");
130 # $outfile should have grown now
131 if ($reopen) { # must close file to update EOF marker for stat
132 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
134 print 'not ' unless (-s $outfile == 2);
138 print 'not ' unless (syswrite(O, $a, 2, 5) == 2);
142 print 'not ' unless ($a eq "#!.\0\0erl");
145 # $outfile should have grown now
146 if ($reopen) { # must close file to update EOF marker for stat
147 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
149 print 'not ' unless (-s $outfile == 4);
152 # with negative offset and a bit too much length
153 print 'not ' unless (syswrite(O, $a, 5, -3) == 3);
157 print 'not ' unless ($a eq "#!.\0\0erl");
160 # $outfile should have grown now
161 if ($reopen) { # must close file to update EOF marker for stat
162 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
164 print 'not ' unless (-s $outfile == 7);
167 # with implicit length argument
168 print 'not ' unless (syswrite(O, $x) == 3);
172 print 'not ' unless ($x eq "abc");
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: $!";
179 print 'not ' unless (-s $outfile == 10);
184 open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
188 # reading too much only return as much as available
189 print 'not ' unless (sysread(I, $b, 100) == 10);
191 # this we should have
192 print 'not ' unless ($b eq '#!ererlabc');
197 print 'not ' unless sysseek(I, 2, 0) == 2;
200 print 'not ' unless $b eq 'ere';
203 print 'not ' unless sysseek(I, -2, 1) == 3;
206 print 'not ' unless $b eq 'rerl';
209 print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
211 print 'not ' if defined sysseek(I, -1, 1);
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/;
224 # y diaresis is \w when UTF8
227 print $a =~ /\w/ ? "not ok 40\n" : "ok 40\n";
231 # Should not be upgraded as a side effect of syswrite.
232 print $a =~ /\w/ ? "not ok 41\n" : "ok 41\n";
235 eval {syswrite I, 2;};
236 print $@ eq "" ? "ok 42\n" : "not ok 42 # $@";