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