sysio.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
print "1..42\n";
@INC = '../../lib';
$x = 'abc';
# should not be able to do negative lengths
print "ok 1\n";
# $x should be intact
print "ok 2\n";
# should not be able to read before the buffer
print "ok 3\n";
# $x should be intact
print "ok 4\n";
$a ='0123456789';
# default offset 0
print "ok 5\n";
# $a should be as follows
print "ok 6\n";
# reading past the buffer should zero pad
print "ok 7\n";
# the zero pad should be seen now
print "ok 8\n";
# try changing the last two characters of $a
print "ok 9\n";
# the last two characters of $a should have changed (into three)
print "ok 10\n";
# cannot write negative lengths
print "ok 11\n";
# $x still intact
print "ok 12\n";
# $outfile still intact
print "ok 13\n";
# should not be able to write from after the buffer
print "ok 14\n";
# $x still intact
print "ok 15\n";
# $outfile still intact
}
print "ok 16\n";
# should not be able to write from before the buffer
print "ok 17\n";
# $x still intact
print "ok 18\n";
# $outfile still intact
}
print "ok 19\n";
# default offset 0
print "ok 20\n";
} else {
print "# $!\nnot ok 20\n";
# most other tests make no sense after e.g. "No space left on device"
die $!;
}
# $a still intact
print "ok 21\n";
# $outfile should have grown now
}
print "ok 22\n";
# with offset
print "ok 23\n";
# $a still intact
print "ok 24\n";
# $outfile should have grown now
}
print "ok 25\n";
# with negative offset and a bit too much length
print "ok 26\n";
# $a still intact
print "ok 27\n";
# $outfile should have grown now
}
print "ok 28\n";
# with implicit length argument
print "ok 29\n";
# $a still intact
print "ok 30\n";
# $outfile should have grown now
}
print "ok 31\n";
$b = 'xyz';
# reading too much only return as much as available
print "ok 32\n";
# this we should have
print "ok 33\n";
# test sysseek
print "ok 34\n";
print "ok 35\n";
print "ok 36\n";
print "ok 37\n";
print "ok 38\n";
print "ok 39\n";
# Check that utf8 IO doesn't upgrade the scalar
# Will skip harmlessly on stdioperl
# y diaresis is \w when UTF8
$a = chr 255;
print $a =~ /\w/ ? "not ok 40\n" : "ok 40\n";
syswrite I, $a;
# Should not be upgraded as a side effect of syswrite.
print $a =~ /\w/ ? "not ok 41\n" : "ok 41\n";
# This should work
eval {syswrite I, 2;};
chdir('..');
1;
# eof