Re: Regex-Unicode bugs

[p5sagit/p5-mst-13.2.git] / t / op / write.t

diff --git a/t/op/write.t b/t/op/write.t
index 8e4cca8..e08a64b 100755 (executable)
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -5,10 +5,11 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..44\n";
+print "1..47\n";
 
-my $CAT = ($^O eq 'MSWin32') ? 'type'
-       : ($^O eq 'MacOS') ? 'catenate' : 'cat';
+my $CAT = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') ? 'type'
+       : ($^O eq 'MacOS') ? 'catenate'
+        : 'cat';
 
 format OUT =
 the quick brown @<<
@@ -35,7 +36,7 @@ $good = 'good';
 $multiline = "forescore\nand\nseven years\n";
 $foo = 'when in the course of human events it becomes necessary';
 write(OUT);
-close OUT;
+close OUT or die "Could not close: $!";
 
 $right =
 "the quick brown fox
@@ -74,7 +75,7 @@ $good = 'good';
 $multiline = "forescore\nand\nseven years\n";
 $foo = 'when in the course of human events it becomes necessary';
 write(OUT2);
-close OUT2;
+close OUT2 or die "Could not close: $!";
 
 $right =
 "the quick brown fox
@@ -117,7 +118,7 @@ $good = 'good';
 $multiline = "forescore\nand\nseven years\n";
 $foo = 'when in the course of human events it becomes necessary';
 write(OUT2);
-close OUT2;
+close OUT2 or die "Could not close: $!";
 
 $right =
 "the brown quick fox
@@ -184,7 +185,7 @@ open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 
 $foo = 'fit          ';
 write(OUT3);
-close OUT3;
+close OUT3 or die "Could not close: $!";
 
 $right =
 "fit\n";
@@ -206,7 +207,7 @@ $this,$that
     write LEX;
     $that = 8;
     write LEX;
-    close LEX;
+    close LEX or die "Could not close: $!";
 }
 # LEX_INTERPNORMAL test
 my %e = ( a => 1 );
@@ -216,7 +217,7 @@ format OUT4 =
 .
 open   OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp";
 write (OUT4);
-close  OUT4;
+close  OUT4 or die "Could not close: $!";
 if (`$CAT Op_write.tmp` eq "1\n") {
     print "ok 9\n";
     1 while unlink "Op_write.tmp";
@@ -236,7 +237,7 @@ open(OUT10, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 
 $test1 = 12.95;
 write(OUT10);
-close OUT10;
+close OUT10 or die "Could not close: $!";
 
 $right = "   12.95 00012.95\n";
 if (`$CAT Op_write.tmp` eq $right)
@@ -259,7 +260,7 @@ open(OUT11, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 
 $test1 = 12.95;
 write(OUT11);
-close OUT11;
+close OUT11 or die "Could not close: $!";
 
 $right = 
 "00012.95
@@ -270,28 +271,61 @@ if (`$CAT Op_write.tmp` eq $right)
 else
     { print "not ok 11\n"; }
 
-# 12..44: scary format testing from Merijn H. Brand
+# 12..47: scary format testing from Merijn H. Brand
+
+if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' ||
+    ($^O eq 'os2' and not eval '$OS2::can_fork')) {
+  foreach (12..47) { print "ok $_ # skipped: '|-' and '-|' not supported\n"; }
+  exit(0);
+}
 
 use strict;    # Amazed that this hackery can be made strict ...
 
+my $test = 12;
+
 # Just a complete test for format, including top-, left- and bottom marging
 # and format detection through glob entries
 
+format EMPTY =
+.
+
+format Comment =
+ok @<<<<<
+$test
+.
+
+$= = 10;
+
+# [ID 20020227.005] format bug with undefined _TOP
+{   local $~ = "Comment";
+    write;
+    $test++;
+    print $- == 9
+       ? "ok $test\n" : "not ok $test # TODO \$- = $- instead of 9\n";
+    $test++;
+    print $^ ne "Comment_TOP"
+       ? "ok $test\n" : "not ok $test # TODO \$^ = $^ instead of 'STDOUT_TOP'\n";
+    $test++;
+    }
+
+   $^  = "STDOUT_TOP";
    $=  =  7;           # Page length
+   $-  =  0;           # Lines left
 my $ps = $^L; $^L = "";        # Catch the page separator
 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)
-    my $i = 12;
+    select ((select (STDOUT), $| = 1)[0]);
     my $s = " " x $lm;
     while (<STDIN>) {
        s/^/$s/;
-       print + ($_ eq <DATA> ? "" : "not "), "ok ", $i++, "\n";
+       print + ($_ eq <DATA> ? "" : "not "), "ok ", $test++, "\n";
        }
     close STDIN;
-    print + (<DATA>?"not ":""), "ok ", $i++, "\n";
+    print + (<DATA>?"not ":""), "ok ", $test++, "\n";
     close STDOUT;
     exit;
     }
@@ -325,9 +359,6 @@ format TOP =
 $tm
 .
 
-format EmptyTOP =
-.
-
 format ENTRY =
 @ @<<<<~~
 @{(shift @E)||["",""]}
@@ -350,7 +381,7 @@ sub has_format ($)
     $@?0:1;
     } # has_format
 
-$^ = has_format ("TOP") ? "TOP" : "EmptyTOP";
+$^ = has_format ("TOP") ? "TOP" : "EMPTY";
 has_format ("ENTRY") or die "No format defined for ENTRY";
 foreach my $e ( [ map { [ $_, "Test$_"   ] } 1 .. 7 ],
                [ map { [ $_, "${_}tseT" ] } 1 .. 5 ]) {
@@ -368,7 +399,7 @@ if (has_format ("EOF")) {
 
 close STDOUT;
 
-# That was test 44.
+# That was test 47.
 
 __END__