projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
make op/write.t work better under stdio by running the subtests
[p5sagit/p5-mst-13.2.git] / t / op / write.t
diff --git a/t/op/write.t b/t/op/write.t
index ccecac3..59fe268 100755 (executable)
--- 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 {
@@ -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 <<EOD ? "ok 16\n" : "not ok 16\n";
 this_is_block_1   this_is_block_2
 this_is_block_3   this_is_block_4
@@ -408,7 +414,7 @@ Here we go: @* That's all, folks!
     open(OUT17, '>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 = <<EOD;
 Here we go: $txt That's all, folks!
@@ -438,7 +444,8 @@ EOD
          '$v' . "\n.\n";
     open(OUT19, '>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 <<EOD ? "ok 19\n" : "not ok 19\n";
 gaga\0
 gaga\0
@@ -466,10 +473,9 @@ $h{xkey}, $h{ykey}
     $exp .= "}\n";
     open(OUT20, '>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
 }
 
 
@@ -491,7 +497,7 @@ for my $tref ( @NumTests ){
                 : $writeres eq $expected;
        
         print $ok
-           ? "ok $nt\n"
+           ? "ok $nt - $writefmt\n"
            : "not ok $nt\n# f=[$writefmt] exp=[$expected] got=[$writeres]\n";
     }
 }
@@ -546,6 +552,7 @@ $= = 10;
     $test++;
 }
 select $oldfh;
+close STDOUT_DUP;
 
 $^  = "STDOUT_TOP";
 $=  =  7;              # Page length
@@ -555,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 <DATA>.
+
+my @data = <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 (<STDIN>) {
+    while (<FROM_CHILD>) {
+       unless (@data) {
+           print "not ok $test - too much output\n";
+           exit;
+       }
        s/^/$s/;
-       print + ($_ eq <DATA> ? "" : "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 + (<DATA>?"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;
Unnamed repository; edit this file to name it for gitweb.