4 chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
11 open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
13 $reopen = ($^O eq 'VMS' ||
22 # should not be able to do negative lengths
23 eval { sysread(I, $x, -1) };
24 like($@, qr/^Negative length /);
29 # should not be able to read before the buffer
30 eval { sysread(I, $x, 1, -4) };
31 like($@, qr/^Offset outside string /);
39 is(sysread(I, $a, 3), 3);
41 # $a should be as follows
44 # reading past the buffer should zero pad
45 is(sysread(I, $a, 2, 5), 2);
47 # the zero pad should be seen now
50 # try changing the last two characters of $a
51 is(sysread(I, $a, 3, -2), 3);
53 # the last two characters of $a should have changed (into three)
56 $outfile = tempfile();
58 open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
60 select(O); $|=1; select(STDOUT);
62 # cannot write negative lengths
63 eval { syswrite(O, $x, -1) };
64 like($@, qr/^Negative length /);
69 # $outfile still intact
72 # should not be able to write from after the buffer
73 eval { syswrite(O, $x, 1, 4) };
74 like($@, qr/^Offset outside string /);
79 # but it should be ok to write from the end of the buffer
80 syswrite(O, $x, 0, 3);
81 syswrite(O, $x, 1, 3);
83 # $outfile still intact
84 if ($reopen) { # must close file to update EOF marker for stat
85 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
89 # should not be able to write from before the buffer
91 eval { syswrite(O, $x, 1, -4) };
92 like($@, qr/^Offset outside string /);
97 # $outfile still intact
98 if ($reopen) { # must close file to update EOF marker for stat
99 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
103 # [perl #67912] syswrite prints garbage if called with empty scalar and non-zero offset
104 eval { my $buf = ''; syswrite(O, $buf, 1, 1) };
105 like($@, qr/^Offset outside string /);
110 # $outfile still intact
111 if ($reopen) { # must close file to update EOF marker for stat
112 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
116 eval { my $buf = 'x'; syswrite(O, $buf, 1, 2) };
117 like($@, qr/^Offset outside string /);
122 # $outfile still intact
123 if ($reopen) { # must close file to update EOF marker for stat
124 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
129 if (syswrite(O, $a, 2) == 2){
134 # most other tests make no sense after e.g. "No space left on device"
140 is($a, "#!.\0\0erl");
142 # $outfile should have grown now
143 if ($reopen) { # must close file to update EOF marker for stat
144 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
149 is(syswrite(O, $a, 2, 5), 2);
152 is($a, "#!.\0\0erl");
154 # $outfile should have grown now
155 if ($reopen) { # must close file to update EOF marker for stat
156 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
160 # with negative offset and a bit too much length
161 is(syswrite(O, $a, 5, -3), 3);
164 is($a, "#!.\0\0erl");
166 # $outfile should have grown now
167 if ($reopen) { # must close file to update EOF marker for stat
168 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
172 # with implicit length argument
173 is(syswrite(O, $x), 3);
178 # $outfile should have grown now
179 if ($reopen) { # must close file to update EOF marker for stat
180 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
186 open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
190 # reading too much only return as much as available
191 is(sysread(I, $b, 100), 10);
193 # this we should have
194 is($b, '#!ererlabc');
198 is(sysseek(I, 2, 0), 2);
202 is(sysseek(I, -2, 1), 3);
206 ok(sysseek(I, 0, 0) eq '0 but true');
208 ok(not defined sysseek(I, -1, 1));
214 # Check that utf8 IO doesn't upgrade the scalar
215 open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
216 # Will skip harmlessly on stdioperl
217 eval {binmode STDOUT, ":utf8"};
218 die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/;
220 # y diaresis is \w when UTF8
227 # Should not be upgraded as a side effect of syswrite.
231 eval {syswrite I, 2;};