X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fwrite.t;h=59fe268f599747d9adbf674a125f22e87d81d720;hb=68ba3c2c674c6fecf165cdd3b5e4da501410ba1a;hp=4f38bfb4d14950f06eef9382ab8aa44320ce524d;hpb=d1f6232ef41498b98b048b7f0d70624010ee6ec7;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/write.t b/t/op/write.t index 4f38bfb..59fe268 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -5,6 +5,16 @@ BEGIN { @INC = '../lib'; } +# read in a file +sub cat { + my $file = shift; + local $/; + open my $fh, $file or die "can't open '$file': $!"; + my $data = <$fh>; + close $fh; + $data; +} + #-- testing numeric fields in all variants (WL) sub swrite { @@ -16,24 +26,24 @@ sub swrite { my @NumTests = ( # [ format, value1, expected1, value2, expected2, .... ] - [ '@###', 0, ' 0', 1, ' 1', 9999.5, '####', - 9999.4999, '9999', -999.5, '####', 1e+100, '####' ], + [ '@###', 0, ' 0', 1, ' 1', 9999.6, '####', + 9999.4999, '9999', -999.6, '####', 1e+100, '####' ], - [ '@0##', 0, '0000', 1, '0001', 9999.5, '####', - -999.4999, '-999', -999.5, '####', 1e+100, '####' ], + [ '@0##', 0, '0000', 1, '0001', 9999.6, '####', + -999.4999, '-999', -999.6, '####', 1e+100, '####' ], [ '^###', 0, ' 0', undef, ' ' ], [ '^0##', 0, '0000', undef, ' ' ], - [ '@###.', 0, ' 0.', 1, ' 1.', 9999.5, '#####', - 9999.4999, '9999.', -999.5, '#####' ], + [ '@###.', 0, ' 0.', 1, ' 1.', 9999.6, '#####', + 9999.4999, '9999.', -999.6, '#####' ], - [ '@##.##', 0, ' 0.00', 1, ' 1.00', 999.995, '######', + [ '@##.##', 0, ' 0.00', 1, ' 1.00', 999.996, '######', 999.99499, '999.99', -100, '######' ], [ '@0#.##', 0, '000.00', 1, '001.00', 10, '010.00', - -0.0001, '-00.00' ], + -0.0001, qr/^[\-0]00\.00$/ ], ); @@ -48,14 +58,10 @@ for my $tref ( @NumTests ){ my $bas_tests = 20; # number of tests in section 3 -my $hmb_tests = 36; +my $hmb_tests = 37; printf "1..%d\n", $bas_tests + $num_tests + $hmb_tests; -my $CAT = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') ? 'type' - : ($^O eq 'MacOS') ? 'catenate' - : 'cat'; - ############ ## Section 1 ############ @@ -99,7 +105,7 @@ the course of huma... now is the time for all good men to come to\n"; -if (`$CAT Op_write.tmp` eq $right) +if (cat('Op_write.tmp') eq $right) { print "ok 1\n"; 1 while unlink 'Op_write.tmp'; } else { print "not ok 1\n"; } @@ -141,7 +147,7 @@ becomes necessary now is the time for all good men to come to\n"; -if (`$CAT Op_write.tmp` eq $right) +if (cat('Op_write.tmp') eq $right) { print "ok 2\n"; 1 while unlink 'Op_write.tmp'; } else { print "not ok 2\n"; } @@ -185,7 +191,7 @@ becomes necessary now is the time for all good men to come to\n"; -if (`$CAT Op_write.tmp` eq $right) +if (cat('Op_write.tmp') eq $right) { print "ok 3\n"; 1 while unlink 'Op_write.tmp'; } else { print "not ok 3\n"; } @@ -240,7 +246,7 @@ close OUT3 or die "Could not close: $!"; $right = "fit\n"; -if (`$CAT Op_write.tmp` eq $right) +if (cat('Op_write.tmp') eq $right) { print "ok 6\n"; 1 while unlink 'Op_write.tmp'; } else { print "not ok 6\n"; } @@ -268,7 +274,7 @@ format OUT4 = open OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp"; write (OUT4); close OUT4 or die "Could not close: $!"; -if (`$CAT Op_write.tmp` eq "1\n") { +if (cat('Op_write.tmp') eq "1\n") { print "ok 9\n"; 1 while unlink "Op_write.tmp"; } @@ -290,7 +296,7 @@ write(OUT10); close OUT10 or die "Could not close: $!"; $right = " 12.95 00012.95\n"; -if (`$CAT Op_write.tmp` eq $right) +if (cat('Op_write.tmp') eq $right) { print "ok 10\n"; 1 while unlink 'Op_write.tmp'; } else { print "not ok 10\n"; } @@ -316,7 +322,7 @@ $right = "00012.95 1 0# 10 #\n"; -if (`$CAT Op_write.tmp` eq $right) +if (cat('Op_write.tmp') eq $right) { print "ok 11\n"; 1 while unlink 'Op_write.tmp'; } else { print "not ok 11\n"; } @@ -334,7 +340,7 @@ $el write(OUT12); } close OUT12 or die "Could not close: $!"; - print `$CAT Op_write.tmp`; + print cat('Op_write.tmp'); } @@ -351,7 +357,7 @@ $v open(OUT13, '>Op_write.tmp') || die "Can't create Op_write.tmp"; write(OUT13); close OUT13 or die "Could not close: $!"; - print `$CAT Op_write.tmp`; + print cat('Op_write.tmp'); } { # test 14 @@ -375,7 +381,7 @@ $txt open(OUT15, '>Op_write.tmp') || die "Can't create Op_write.tmp"; write(OUT15); close OUT15 or die "Could not close: $!"; - my $res = `$CAT Op_write.tmp`; + my $res = cat('Op_write.tmp'); print $res eq "line 1\nline 2\n" ? "ok 15\n" : "not ok 15\n"; } @@ -390,7 +396,7 @@ $txt, $txt open(OUT16, '>Op_write.tmp') || die "Can't create Op_write.tmp"; write(OUT16); close OUT16 or die "Could not close: $!"; - my $res = `$CAT Op_write.tmp`; + my $res = cat('Op_write.tmp'); print $res eq <Op_write.tmp') || die "Can't create Op_write.tmp"; write(OUT17); close OUT17 or die "Could not close: $!"; - my $res = `$CAT Op_write.tmp`; + my $res = cat('Op_write.tmp'); chomp( $txt ); my $exp = <Op_write.tmp') || die "Can't create Op_write.tmp"; write(OUT19); - my $res = `$CAT Op_write.tmp`; + close OUT19 or die "Could not close: $!"; + my $res = cat('Op_write.tmp'); print $res eq <Op_write.tmp') || die "Can't create Op_write.tmp"; write(OUT20); - my $res = `$CAT Op_write.tmp`; + close OUT20 or die "Could not close: $!"; + my $res = cat('Op_write.tmp'); print $res eq $exp ? "ok 20\n" : "not ok 20 res=[$res]exp=[$exp]\n"; - -EOD } @@ -486,8 +492,13 @@ for my $tref ( @NumTests ){ my $expected = shift @$tref; my $writeres = swrite( $writefmt, $val ); $nt++; - - print $expected eq $writeres ? "ok $nt\n" : "not ok $nt\n"; + my $ok = ref($expected) + ? $writeres =~ $expected + : $writeres eq $expected; + + print $ok + ? "ok $nt - $writefmt\n" + : "not ok $nt\n# f=[$writefmt] exp=[$expected] got=[$writeres]\n"; } } @@ -541,6 +552,7 @@ $= = 10; $test++; } select $oldfh; +close STDOUT_DUP; $^ = "STDOUT_TOP"; $= = 7; # Page length @@ -550,19 +562,46 @@ my $tm = 1; # Top margin (empty lines before first output) my $bm = 2; # Bottom marging (empty lines between last text and footer) my $lm = 4; # Left margin (indent in spaces) -select ((select (STDOUT), $| = 1)[0]); -if ($lm > 0 and !open STDOUT, "|-") { # Left margin (in this test ALWAYS set) - select ((select (STDOUT), $| = 1)[0]); +# ----------------------------------------------------------------------- +# +# execute the rest of the script in a child process. The parent reads the +# output from the child and compares it with . + +my @data = ; + +select ((select (STDOUT), $| = 1)[0]); # flush STDOUT + +my $opened = open FROM_CHILD, "-|"; +unless (defined $opened) { + print "not ok $test - open gave $!\n"; exit 0; +} + +if ($opened) { + # in parent here + + print "ok $test - open\n"; $test++; my $s = " " x $lm; - while () { + while () { + unless (@data) { + print "not ok $test - too much output\n"; + exit; + } s/^/$s/; - print + ($_ eq ? "" : "not "), "ok ", $test++, "\n"; + my $exp = shift @data; + print + ($_ eq $exp ? "" : "not "), "ok ", $test++, " \n"; + if ($_ ne $exp) { + s/\n/\\n/g for $_, $exp; + print "#expected: $exp\n#got: $_\n"; } - close STDIN; - print + (?"not ":""), "ok ", $test++, "\n"; - close STDOUT; - exit; } + close FROM_CHILD; + print + (@data?"not ":""), "ok ", $test++, " - too litle output\n"; + exit; +} + +# in child here + + select ((select (STDOUT), $| = 1)[0]); $tm = "\n" x $tm; $= -= $bm + 1; # count one for the trailing "----" my $lastmin = 0;