From: Vincent Pit Date: Mon, 27 Jul 2009 16:07:50 +0000 (+0200) Subject: Port t/op/sysio.t to test.pl X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dfeca2c828987964ee831268223821a24ce9de6f;p=p5sagit%2Fp5-mst-13.2.git Port t/op/sysio.t to test.pl This also fix the breakage I caused to the test in my previous commit --- diff --git a/t/op/sysio.t b/t/op/sysio.t index b4c2954..c777afb 100644 --- a/t/op/sysio.t +++ b/t/op/sysio.t @@ -1,10 +1,12 @@ #!./perl -print "1..44\n"; +BEGIN { + chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!"; + @INC = '../../lib'; + require '../test.pl'; +} -chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!"; -@INC = '../../lib'; -require '../test.pl'; +plan tests => 48; open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!"; @@ -19,47 +21,37 @@ $x = 'abc'; # should not be able to do negative lengths eval { sysread(I, $x, -1) }; -print 'not ' unless ($@ =~ /^Negative length /); -print "ok 1\n"; +like($@, qr/^Negative length /); # $x should be intact -print 'not ' unless ($x eq 'abc'); -print "ok 2\n"; +is($x, 'abc'); # should not be able to read before the buffer eval { sysread(I, $x, 1, -4) }; -print 'not ' unless ($x eq 'abc'); -print "ok 3\n"; +is($x, 'abc'); # $x should be intact -print 'not ' unless ($x eq 'abc'); -print "ok 4\n"; +is($x, 'abc'); $a ='0123456789'; # default offset 0 -print 'not ' unless(sysread(I, $a, 3) == 3); -print "ok 5\n"; +is(sysread(I, $a, 3), 3); # $a should be as follows -print 'not ' unless ($a eq '#!.'); -print "ok 6\n"; +is($a, '#!.'); # reading past the buffer should zero pad -print 'not ' unless(sysread(I, $a, 2, 5) == 2); -print "ok 7\n"; +is(sysread(I, $a, 2, 5), 2); # the zero pad should be seen now -print 'not ' unless ($a eq "#!.\0\0/p"); -print "ok 8\n"; +is($a, "#!.\0\0/p"); # try changing the last two characters of $a -print 'not ' unless(sysread(I, $a, 3, -2) == 3); -print "ok 9\n"; +is(sysread(I, $a, 3, -2), 3); # the last two characters of $a should have changed (into three) -print 'not ' unless ($a eq "#!.\0\0erl"); -print "ok 10\n"; +is($a, "#!.\0\0erl"); $outfile = tempfile(); @@ -69,145 +61,147 @@ select(O); $|=1; select(STDOUT); # cannot write negative lengths eval { syswrite(O, $x, -1) }; -print 'not ' unless ($@ =~ /^Negative length /); -print "ok 11\n"; +like($@, qr/^Negative length /); # $x still intact -print 'not ' unless ($x eq 'abc'); -print "ok 12\n"; +is($x, 'abc'); # $outfile still intact -print 'not ' if (-s $outfile); -print "ok 13\n"; +ok(!-s $outfile); # should not be able to write from after the buffer eval { syswrite(O, $x, 1, 3) }; -print 'not ' unless ($@ =~ /^Offset outside string /); -print "ok 14\n"; +like($@, qr/^Offset outside string /); # $x still intact -print 'not ' unless ($x eq 'abc'); -print "ok 15\n"; +is($x, 'abc'); # $outfile still intact if ($reopen) { # must close file to update EOF marker for stat close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; } -print 'not ' if (-s $outfile); -print "ok 16\n"; +ok(!-s $outfile); # should not be able to write from before the buffer eval { syswrite(O, $x, 1, -4) }; -print 'not ' unless ($@ =~ /^Offset outside string /); -print "ok 17\n"; +like($@, qr/^Offset outside string /); + +# $x still intact +is($x, 'abc'); + +# $outfile still intact +if ($reopen) { # must close file to update EOF marker for stat + close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; +} +ok(!-s $outfile); + +# [perl #67912] syswrite prints garbage if called with empty scalar and non-zero offset +eval { my $buf = ''; syswrite(O, $buf, 1, 0) }; +like($@, qr/^Offset outside string /); # $x still intact -print 'not ' unless ($x eq 'abc'); -print "ok 18\n"; +is($x, 'abc'); # $outfile still intact if ($reopen) { # must close file to update EOF marker for stat close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; } -print 'not ' if (-s $outfile); -print "ok 19\n"; +ok(!-s $outfile); + +eval { my $buf = 'x'; syswrite(O, $buf, 1, 1) }; +like($@, qr/^Offset outside string /); + +# $x still intact +is($x, 'abc'); + +# $outfile still intact +if ($reopen) { # must close file to update EOF marker for stat + close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; +} +ok(!-s $outfile); # default offset 0 if (syswrite(O, $a, 2) == 2){ - print "ok 20\n"; + pass(); } else { - print "# $!\nnot ok 20\n"; + diag($!); + fail(); # most other tests make no sense after e.g. "No space left on device" die $!; } # $a still intact -print 'not ' unless ($a eq "#!.\0\0erl"); -print "ok 21\n"; +is($a, "#!.\0\0erl"); # $outfile should have grown now if ($reopen) { # must close file to update EOF marker for stat close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; } -print 'not ' unless (-s $outfile == 2); -print "ok 22\n"; +is(-s $outfile, 2); # with offset -print 'not ' unless (syswrite(O, $a, 2, 5) == 2); -print "ok 23\n"; +is(syswrite(O, $a, 2, 5), 2); # $a still intact -print 'not ' unless ($a eq "#!.\0\0erl"); -print "ok 24\n"; +is($a, "#!.\0\0erl"); # $outfile should have grown now if ($reopen) { # must close file to update EOF marker for stat close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; } -print 'not ' unless (-s $outfile == 4); -print "ok 25\n"; +is(-s $outfile, 4); # with negative offset and a bit too much length -print 'not ' unless (syswrite(O, $a, 5, -3) == 3); -print "ok 26\n"; +is(syswrite(O, $a, 5, -3), 3); # $a still intact -print 'not ' unless ($a eq "#!.\0\0erl"); -print "ok 27\n"; +is($a, "#!.\0\0erl"); # $outfile should have grown now if ($reopen) { # must close file to update EOF marker for stat close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; } -print 'not ' unless (-s $outfile == 7); -print "ok 28\n"; +is(-s $outfile, 7); # with implicit length argument -print 'not ' unless (syswrite(O, $x) == 3); -print "ok 29\n"; +is(syswrite(O, $x), 3); # $a still intact -print 'not ' unless ($x eq "abc"); -print "ok 30\n"; +is($x, "abc"); # $outfile should have grown now if ($reopen) { # must close file to update EOF marker for stat close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; } -print 'not ' unless (-s $outfile == 10); -print "ok 31\n"; +is(-s $outfile, 10); + +close(O); open(I, $outfile) || die "sysio.t: cannot read $outfile: $!"; $b = 'xyz'; # reading too much only return as much as available -print 'not ' unless (sysread(I, $b, 100) == 10); -print "ok 32\n"; +is(sysread(I, $b, 100), 10); + # this we should have -print 'not ' unless ($b eq '#!ererlabc'); -print "ok 33\n"; +is($b, '#!ererlabc'); # test sysseek -print 'not ' unless sysseek(I, 2, 0) == 2; -print "ok 34\n"; +is(sysseek(I, 2, 0), 2); sysread(I, $b, 3); -print 'not ' unless $b eq 'ere'; -print "ok 35\n"; +is($b, 'ere'); -print 'not ' unless sysseek(I, -2, 1) == 3; -print "ok 36\n"; +is(sysseek(I, -2, 1), 3); sysread(I, $b, 4); -print 'not ' unless $b eq 'rerl'; -print "ok 37\n"; +is($b, 'rerl'); + +ok(sysseek(I, 0, 0) eq '0 but true'); -print 'not ' unless sysseek(I, 0, 0) eq '0 but true'; -print "ok 38\n"; -print 'not ' if defined sysseek(I, -1, 1); -print "ok 39\n"; +ok(not defined sysseek(I, -1, 1)); close(I); @@ -222,33 +216,22 @@ die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/; # y diaresis is \w when UTF8 $a = chr 255; -print $a =~ /\w/ ? "not ok 40\n" : "ok 40\n"; +unlike($a, qr/\w/); syswrite I, $a; # Should not be upgraded as a side effect of syswrite. -print $a =~ /\w/ ? "not ok 41\n" : "ok 41\n"; +unlike($a, qr/\w/); # This should work eval {syswrite I, 2;}; -print $@ eq "" ? "ok 42\n" : "not ok 42 # $@"; +is($@, ''); close(I); unlink $outfile; chdir('..'); -# [perl #67912] syswrite prints garbage if called with empty scalar and non-zero offset -eval { my $buf = ''; syswrite(O, $buf, 1, 0) }; -print 'not ' unless ($@ =~ /^Offset outside string /); -print "ok 43\n"; - -eval { my $buf = 'x'; syswrite(O, $buf, 1, 1) }; -print 'not ' unless ($@ =~ /^Offset outside string /); -print "ok 44\n"; - -close(O); - 1; # eof