1#!./perl 2 3BEGIN { 4 chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!"; 5 @INC = '../../lib'; 6 require '../test.pl'; 7} 8 9plan tests => 48; 10 11open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!"; 12 13$reopen = ($^O eq 'VMS' || 14 $^O eq 'os2' || 15 $^O eq 'MSWin32' || 16 $^O eq 'NetWare' || 17 $^O eq 'dos' || 18 $^O eq 'mpeix'); 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: $!"; 59 60select(O); $|=1; select(STDOUT); 61 62# cannot write negative lengths 63eval { syswrite(O, $x, -1) }; 64like($@, qr/^Negative length /); 65 66# $x still intact 67is($x, 'abc'); 68 69# $outfile still intact 70ok(!-s $outfile); 71 72# should not be able to write from after the buffer 73eval { syswrite(O, $x, 1, 4) }; 74like($@, qr/^Offset outside string /); 75 76# $x still intact 77is($x, 'abc'); 78 79# but it should be ok to write from the end of the buffer 80syswrite(O, $x, 0, 3); 81syswrite(O, $x, 1, 3); 82 83# $outfile still intact 84if ($reopen) { # must close file to update EOF marker for stat 85 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 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} 101ok(!-s $outfile); 102 103# [perl #67912] syswrite prints garbage if called with empty scalar and non-zero offset 104eval { my $buf = ''; syswrite(O, $buf, 1, 1) }; 105like($@, qr/^Offset outside string /); 106 107# $x still intact 108is($x, 'abc'); 109 110# $outfile still intact 111if ($reopen) { # must close file to update EOF marker for stat 112 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 113} 114ok(!-s $outfile); 115 116eval { my $buf = 'x'; syswrite(O, $buf, 1, 2) }; 117like($@, qr/^Offset outside string /); 118 119# $x still intact 120is($x, 'abc'); 121 122# $outfile still intact 123if ($reopen) { # must close file to update EOF marker for stat 124 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 125} 126ok(!-s $outfile); 127 128# default offset 0 129if (syswrite(O, $a, 2) == 2){ 130 pass(); 131} else { 132 diag($!); 133 fail(); 134 # most other tests make no sense after e.g. "No space left on device" 135 die $!; 136} 137 138 139# $a still intact 140is($a, "#!.\0\0erl"); 141 142# $outfile should have grown now 143if ($reopen) { # must close file to update EOF marker for stat 144 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 145} 146is(-s $outfile, 2); 147 148# with offset 149is(syswrite(O, $a, 2, 5), 2); 150 151# $a still intact 152is($a, "#!.\0\0erl"); 153 154# $outfile should have grown now 155if ($reopen) { # must close file to update EOF marker for stat 156 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 157} 158is(-s $outfile, 4); 159 160# with negative offset and a bit too much length 161is(syswrite(O, $a, 5, -3), 3); 162 163# $a still intact 164is($a, "#!.\0\0erl"); 165 166# $outfile should have grown now 167if ($reopen) { # must close file to update EOF marker for stat 168 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 169} 170is(-s $outfile, 7); 171 172# with implicit length argument 173is(syswrite(O, $x), 3); 174 175# $a still intact 176is($x, "abc"); 177 178# $outfile should have grown now 179if ($reopen) { # must close file to update EOF marker for stat 180 close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; 181} 182is(-s $outfile, 10); 183 184close(O); 185 186open(I, $outfile) || die "sysio.t: cannot read $outfile: $!"; 187 188$b = 'xyz'; 189 190# reading too much only return as much as available 191is(sysread(I, $b, 100), 10); 192 193# this we should have 194is($b, '#!ererlabc'); 195 196# test sysseek 197 198is(sysseek(I, 2, 0), 2); 199sysread(I, $b, 3); 200is($b, 'ere'); 201 202is(sysseek(I, -2, 1), 3); 203sysread(I, $b, 4); 204is($b, 'rerl'); 205 206ok(sysseek(I, 0, 0) eq '0 but true'); 207 208ok(not defined sysseek(I, -1, 1)); 209 210close(I); 211 212unlink $outfile; 213 214# Check that utf8 IO doesn't upgrade the scalar 215open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!"; 216# Will skip harmlessly on stdioperl 217eval {binmode STDOUT, ":utf8"}; 218die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/; 219 220# y diaresis is \w when UTF8 221$a = chr 255; 222 223unlike($a, qr/\w/); 224 225syswrite I, $a; 226 227# Should not be upgraded as a side effect of syswrite. 228unlike($a, qr/\w/); 229 230# This should work 231eval {syswrite I, 2;}; 232is($@, ''); 233 234close(I); 235unlink $outfile; 236 237chdir('..'); 238 2391; 240 241# eof 242