1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7} 8 9plan tests => 45; 10 11open(I, 'op/sysio.t') || die "sysio.t: cannot find myself: $!"; 12binmode I; 13 14$reopen = ($^O eq 'VMS' || 15 $^O eq 'os2' || 16 $^O eq 'MSWin32' || 17 $^O eq 'NetWare' || 18 $^O eq 'dos'); 19 20$x = 'abc'; 21 22# should not be able to do negative lengths 23eval { sysread(I, $x, -1) }; 24like($@, qr/^Negative length /); 25 26# $x should be intact 27is($x, 'abc'); 28 29# should not be able to read before the buffer 30eval { sysread(I, $x, 1, -4) }; 31like($@, qr/^Offset outside string /); 32 33# $x should be intact 34is($x, 'abc'); 35 36$a ='0123456789'; 37 38# default offset 0 39is(sysread(I, $a, 3), 3); 40 41# $a should be as follows 42is($a, '#!.'); 43 44# reading past the buffer should zero pad 45is(sysread(I, $a, 2, 5), 2); 46 47# the zero pad should be seen now 48is($a, "#!.\0\0/p"); 49 50# try changing the last two characters of $a 51is(sysread(I, $a, 3, -2), 3); 52 53# the last two characters of $a should have changed (into three) 54is($a, "#!.\0\0erl"); 55 56$outfile = tempfile(); 57 58open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!"; 59binmode O; 60 61select(O); $|=1; select(STDOUT); 62 63# cannot write negative lengths 64eval { syswrite(O, $x, -1) }; 65like($@, qr/^Negative length /); 66 67# $x still intact 68is($x, 'abc'); 69 70# $outfile still intact 71ok(!-s $outfile); 72 73# should not be able to write from after the buffer 74eval { syswrite(O, $x, 1, 4) }; 75like($@, qr/^Offset outside string /); 76 77# $x still intact 78is($x, 'abc'); 79 80# but it should be ok to write from the end of the buffer 81syswrite(O, $x, 0, 3); 82syswrite(O, $x, 1, 3); 83 84# $outfile still intact 85if ($reopen) { # must close file to update EOF marker for stat 86 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 87 binmode O; 88} 89ok(!-s $outfile); 90 91# should not be able to write from before the buffer 92 93eval { syswrite(O, $x, 1, -4) }; 94like($@, qr/^Offset outside string /); 95 96# $x still intact 97is($x, 'abc'); 98 99# $outfile still intact 100if ($reopen) { # must close file to update EOF marker for stat 101 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 102 binmode O; 103} 104ok(!-s $outfile); 105 106# [perl #67912] syswrite prints garbage if called with empty scalar and non-zero offset 107eval { my $buf = ''; syswrite(O, $buf, 1, 1) }; 108like($@, qr/^Offset outside string /); 109 110# $x still intact 111is($x, 'abc'); 112 113# $outfile still intact 114if ($reopen) { # must close file to update EOF marker for stat 115 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 116 binmode O; 117} 118ok(!-s $outfile); 119 120eval { my $buf = 'x'; syswrite(O, $buf, 1, 2) }; 121like($@, qr/^Offset outside string /); 122 123# $x still intact 124is($x, 'abc'); 125 126# $outfile still intact 127if ($reopen) { # must close file to update EOF marker for stat 128 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 129 binmode O; 130} 131ok(!-s $outfile); 132 133# default offset 0 134if (syswrite(O, $a, 2) == 2){ 135 pass(); 136} else { 137 diag($!); 138 fail(); 139 # most other tests make no sense after e.g. "No space left on device" 140 die $!; 141} 142 143 144# $a still intact 145is($a, "#!.\0\0erl"); 146 147# $outfile should have grown now 148if ($reopen) { # must close file to update EOF marker for stat 149 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 150 binmode O; 151} 152is(-s $outfile, 2); 153 154# with offset 155is(syswrite(O, $a, 2, 5), 2); 156 157# $a still intact 158is($a, "#!.\0\0erl"); 159 160# $outfile should have grown now 161if ($reopen) { # must close file to update EOF marker for stat 162 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 163 binmode O; 164} 165is(-s $outfile, 4); 166 167# with negative offset and a bit too much length 168is(syswrite(O, $a, 5, -3), 3); 169 170# $a still intact 171is($a, "#!.\0\0erl"); 172 173# $outfile should have grown now 174if ($reopen) { # must close file to update EOF marker for stat 175 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 176 binmode O; 177} 178is(-s $outfile, 7); 179 180# with implicit length argument 181is(syswrite(O, $x), 3); 182 183# $a still intact 184is($x, "abc"); 185 186# $outfile should have grown now 187if ($reopen) { # must close file to update EOF marker for stat 188 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 189 binmode O; 190} 191is(-s $outfile, 10); 192 193close(O); 194 195open(I, $outfile) || die "sysio.t: cannot read $outfile: $!"; 196binmode I; 197 198$b = 'xyz'; 199 200# reading too much only return as much as available 201is(sysread(I, $b, 100), 10); 202 203# this we should have 204is($b, '#!ererlabc'); 205 206# test sysseek 207 208is(sysseek(I, 2, 0), 2); 209sysread(I, $b, 3); 210is($b, 'ere'); 211 212is(sysseek(I, -2, 1), 3); 213sysread(I, $b, 4); 214is($b, 'rerl'); 215 216ok(sysseek(I, 0, 0) eq '0 but true'); 217 218ok(not defined sysseek(I, -1, 1)); 219 220close(I); 221 222unlink_all $outfile; 223 224chdir('..'); 225 2261; 227 228# eof 229