fix write test: -small_number may be displayed as 00.00 or -0.00

[perl5.git] / t / op / write.t

diff --git a/t/op/write.t b/t/op/write.t
index 6e37cac..52ba517 100755 (executable)
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -15,30 +15,32 @@ sub swrite {
 }
 
 my @NumTests = (
-    [ '@###',   0, 1, 9999.5, 9999.4999, -999.5, 1e100 ],
-    [ '@0##',   0, 1, 9999.5, -999.4999, -999.5, 1e100 ],
-    [ '^###',   0, undef ],
-    [ '^0##',   0, undef ],
-    [ '@###.',  0, 1, 9999.5, 9999.4999, -999.5 ],
-    [ '@##.##', 0, 1, 999.995, 999.99499, -100 ],
-    [ '@0#.##', 0, 1, 10, -0.0001 ],
-           );
-
-sub mkfmt($){
-    my $fmt = shift();
-    my $fieldwidth = length( $fmt );
-    my $leadzero = $fmt =~ /^.0/ ? "0" : "";
-    if( $fmt =~ /\.(#*)/ ){
-        my $fractwidth = length( $1 );
-        return "%#${leadzero}${fieldwidth}.${fractwidth}f"
-    } else {
-        return "%${leadzero}${fieldwidth}.0f"
-    }
-} 
+    # [ format, value1, expected1, value2, expected2, .... ]
+    [ '@###',           0,   '   0',         1, '   1',     9999.5, '####',
+               9999.4999,   '9999',    -999.5, '####',     1e+100, '####' ],
+
+    [ '@0##',           0,   '0000',         1, '0001',     9999.5, '####',
+               -999.4999,   '-999',    -999.5, '####',     1e+100, '####' ],
+
+    [ '^###',           0,   '   0',     undef, '    ' ],
+
+    [ '^0##',           0,   '0000',     undef, '    ' ],
+
+    [ '@###.',          0,  '   0.',         1, '   1.',    9999.5, '#####',
+                9999.4999,  '9999.',    -999.5, '#####' ],
+
+    [ '@##.##',         0, '  0.00',         1, '  1.00',  999.995, '######',
+                999.99499, '999.99',      -100, '######' ],
+
+    [ '@0#.##',         0, '000.00',         1, '001.00',       10, '010.00',
+                  -0.0001, qr/^[\-0]00\.00$/ ],
+
+);
+
 
 my $num_tests = 0;
 for my $tref ( @NumTests ){
-    $num_tests += @$tref - 1;
+    $num_tests += (@$tref - 1)/2;
 }
 #---------------------------------------------------------
 
@@ -479,22 +481,18 @@ EOD
 my $nt = $bas_tests;
 for my $tref ( @NumTests ){
     my $writefmt = shift( @$tref );
-    my $printfmt = mkfmt( $writefmt );
-    my $blank_when_undef = substr( $writefmt, 0, 1 ) eq '^';
-    for my $val ( @$tref ){
+    while (@$tref) {
+       my $val      = shift @$tref;
+       my $expected = shift @$tref;
         my $writeres = swrite( $writefmt, $val );
-        my $printres;
-        if( $blank_when_undef && ! defined($val) ){
-            $printres = ' ' x length( $writefmt );
-        } else {
-            $printres = sprintf( $printfmt, $val || 0 );
-            if( length($printres) > length( $writefmt ) ){
-                $printres = '#' x length( $writefmt );
-            }
-        }
         $nt++;
-
-        print $printres eq $writeres ? "ok $nt\n" : "not ok $nt\n";
+       my $ok = ref($expected)
+                ? $writeres =~ $expected
+                : $writeres eq $expected;
+       
+        print $ok
+           ? "ok $nt\n"
+           : "not ok $nt\n# f=[$writefmt] exp=[$expected] got=[$writeres]\n";
     }
 }
 
@@ -531,23 +529,27 @@ ok @<<<<<
 $test
 .
 
-$= = 10;
 
 # [ID 20020227.005] format bug with undefined _TOP
+
+open STDOUT_DUP, ">&STDOUT";
+my $oldfh = select STDOUT_DUP;
+$= = 10;
 {   local $~ = "Comment";
     write;
     $test++;
     print $- == 9
        ? "ok $test # TODO\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";
+    print $^ eq "STDOUT_DUP_TOP"
+       ? "ok $test\n" : "not ok $test\n# \$^ = $^ instead of 'STDOUT_DUP_TOP'\n";
     $test++;
-    }
+}
+select $oldfh;
 
-   $^  = "STDOUT_TOP";
-   $=  =  7;           # Page length
-   $-  =  0;           # Lines left
+$^  = "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)