5 chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
8 open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
10 $reopen = ($^O eq 'VMS' ||
19 # should not be able to do negative lengths
20 eval { sysread(I, $x, -1) };
21 print 'not ' unless ($@ =~ /^Negative length /);
25 print 'not ' unless ($x eq 'abc');
28 # should not be able to read before the buffer
29 eval { sysread(I, $x, 1, -4) };
30 print 'not ' unless ($x eq 'abc');
34 print 'not ' unless ($x eq 'abc');
40 print 'not ' unless(sysread(I, $a, 3) == 3);
43 # $a should be as follows
44 print 'not ' unless ($a eq '#!.');
47 # reading past the buffer should zero pad
48 print 'not ' unless(sysread(I, $a, 2, 5) == 2);
51 # the zero pad should be seen now
52 print 'not ' unless ($a eq "#!.\0\0/p");
55 # try changing the last two characters of $a
56 print 'not ' unless(sysread(I, $a, 3, -2) == 3);
59 # the last two characters of $a should have changed (into three)
60 print 'not ' unless ($a eq "#!.\0\0erl");
63 $outfile = 'sysio.out';
65 open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
67 select(O); $|=1; select(STDOUT);
69 # cannot write negative lengths
70 eval { syswrite(O, $x, -1) };
71 print 'not ' unless ($@ =~ /^Negative length /);
75 print 'not ' unless ($x eq 'abc');
78 # $outfile still intact
79 print 'not ' if (-s $outfile);
82 # should not be able to write from after the buffer
83 eval { syswrite(O, $x, 1, 3) };
84 print 'not ' unless ($@ =~ /^Offset outside string /);
88 print 'not ' unless ($x eq 'abc');
91 # $outfile still intact
92 if ($reopen) { # must close file to update EOF marker for stat
93 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
95 print 'not ' if (-s $outfile);
98 # should not be able to write from before the buffer
100 eval { syswrite(O, $x, 1, -4) };
101 print 'not ' unless ($@ =~ /^Offset outside string /);
105 print 'not ' unless ($x eq 'abc');
108 # $outfile still intact
109 if ($reopen) { # must close file to update EOF marker for stat
110 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
112 print 'not ' if (-s $outfile);
116 if (syswrite(O, $a, 2) == 2){
119 print "# $!\nnot ok 20\n";
120 # most other tests make no sense after e.g. "No space left on device"
126 print 'not ' unless ($a eq "#!.\0\0erl");
129 # $outfile should have grown now
130 if ($reopen) { # must close file to update EOF marker for stat
131 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
133 print 'not ' unless (-s $outfile == 2);
137 print 'not ' unless (syswrite(O, $a, 2, 5) == 2);
141 print 'not ' unless ($a eq "#!.\0\0erl");
144 # $outfile should have grown now
145 if ($reopen) { # must close file to update EOF marker for stat
146 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
148 print 'not ' unless (-s $outfile == 4);
151 # with negative offset and a bit too much length
152 print 'not ' unless (syswrite(O, $a, 5, -3) == 3);
156 print 'not ' unless ($a eq "#!.\0\0erl");
159 # $outfile should have grown now
160 if ($reopen) { # must close file to update EOF marker for stat
161 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
163 print 'not ' unless (-s $outfile == 7);
166 # with implicit length argument
167 print 'not ' unless (syswrite(O, $x) == 3);
171 print 'not ' unless ($x eq "abc");
174 # $outfile should have grown now
175 if ($reopen) { # must close file to update EOF marker for stat
176 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
178 print 'not ' unless (-s $outfile == 10);
183 open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
187 # reading too much only return as much as available
188 print 'not ' unless (sysread(I, $b, 100) == 10);
190 # this we should have
191 print 'not ' unless ($b eq '#!ererlabc');
196 print 'not ' unless sysseek(I, 2, 0) == 2;
199 print 'not ' unless $b eq 'ere';
202 print 'not ' unless sysseek(I, -2, 1) == 3;
205 print 'not ' unless $b eq 'rerl';
208 print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
210 print 'not ' if defined sysseek(I, -1, 1);
217 # Check that utf8 IO doesn't upgrade the scalar
218 open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
219 # Will skip harmlessly on stdioperl
220 eval {binmode STDOUT, ":utf8"};
221 die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/;
223 # y diaresis is \w when UTF8
226 print $a =~ /\w/ ? "not ok 40\n" : "ok 40\n";
230 # Should not be upgraded as a side effect of syswrite.
231 print $a =~ /\w/ ? "not ok 41\n" : "ok 41\n";
234 eval {syswrite I, 2;};
235 print $@ eq "" ? "ok 42\n" : "not ok 42 # $@";