The test suite tweak in #6101 wasn't quite right.
[p5sagit/p5-mst-13.2.git] / t / lib / complex.t
index 2bb14f0..b659142 100755 (executable)
@@ -9,12 +9,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    unshift @INC, '../lib';
 }
 
 use Math::Complex;
 
-$VERSION = sprintf("%s", q$Id: complex.t,v 1.8 1998/02/05 16:03:39 jhi Exp $ =~ /(\d+\.d+)/);
+my $VERSION = sprintf("%s", q$Id: complex.t,v 1.9 1998/11/01 00:00:00 dsl Exp $ =~ /(\d+\.d+)/);
 
 my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
 
@@ -27,7 +27,7 @@ my @script = (
 my $eps = 1e-13;
 
 if ($^O eq 'unicos') {         # For some reason root() produces very inaccurate
-    $eps = 1e-11;      # results in Cray UNICOS, and occasionally also
+    $eps = 1e-10;      # results in Cray UNICOS, and occasionally also
 }                      # cos(), sin(), cosh(), sinh().  The division
                        # of doubles is the current suspect.
 
@@ -73,6 +73,7 @@ push(@script, <<'EOT');
     my $z = cplx(  1,  1);
     $z->Re(2);
     $z->Im(3);
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
     print 'not ' unless Re($z) == 2 and Im($z) == 3;
 EOT
     push(@script, qq(print "ok $test\\n"}\n));
@@ -82,6 +83,7 @@ push(@script, <<'EOT');
 {
     my $z = cplx(  1,  1);
     $z->abs(3 * sqrt(2));
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
     print 'not ' unless (abs($z) - 3 * sqrt(2)) < $eps and
                         (arg($z) - pi / 4     ) < $eps and
                         (Re($z) - 3           ) < $eps and
@@ -94,6 +96,7 @@ push(@script, <<'EOT');
 {
     my $z = cplx(  1,  1);
     $z->arg(-3 / 4 * pi);
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
     print 'not ' unless (arg($z) + 3 / 4 * pi) < $eps and
                         (abs($z) - sqrt(2)   ) < $eps and
                         (Re($z) + 1          ) < $eps and
@@ -120,10 +123,11 @@ push(@script, $constants);
 sub test_dbz {
     for my $op (@_) {
        $test++;
-
        push(@script, <<EOT);
-eval '$op';
-print 'not ' unless (\$@ =~ /Division by zero/);
+       eval '$op';
+       (\$bad) = (\$@ =~ /(.+)/);
+       print "# $test op = $op divbyzero? \$bad...\n";
+       print 'not ' unless (\$@ =~ /Division by zero/);
 EOT
         push(@script, qq(print "ok $test\\n";\n));
     }
@@ -134,10 +138,11 @@ EOT
 sub test_loz {
     for my $op (@_) {
        $test++;
-
        push(@script, <<EOT);
-eval '$op';
-print 'not ' unless (\$@ =~ /Logarithm of zero/);
+       eval '$op';
+       (\$bad) = (\$@ =~ /(.+)/);
+       print "# $test op = $op logofzero? \$bad...\n";
+       print 'not ' unless (\$@ =~ /Logarithm of zero/);
 EOT
         push(@script, qq(print "ok $test\\n";\n));
     }
@@ -154,48 +159,33 @@ test_dbz(
         'acsch(0)',
         'asec(0)',
         'asech(0)',
-        'atan(-$i)',
         'atan($i)',
 #       'atanh(-1)',   # Log of zero.
         'atanh(+1)',
         'cot(0)',
         'coth(0)',
         'csc(0)',
-        'tan($pip2)',
         'csch(0)',
-        'tan($pip2)',
        );
 
 test_loz(
         'log($zero)',
+        'atan(-$i)',
         'acot(-$i)',
         'atanh(-1)',
         'acoth(-1)',
        );
 
-# test the 0**0
-
-sub test_ztz {
-    $test++;
-
-    push(@script, <<'EOT');
-eval 'cplx(0)**cplx(0)';
-print 'not ' unless ($@ =~ /zero raised to the zeroth/);
-EOT
-    push(@script, qq(print "ok $test\\n";\n));
-}
-
-test_ztz;
-
 # test the bad roots
 
 sub test_broot {
     for my $op (@_) {
        $test++;
-
        push(@script, <<EOT);
-eval 'root(2, $op)';
-print 'not ' unless (\$@ =~ /root must be/);
+       eval 'root(2, $op)';
+       (\$bad) = (\$@ =~ /(.+)/);
+       print "# $test op = $op badroot? \$bad...\n";
+       print 'not ' unless (\$@ =~ /root rank must be/);
 EOT
         push(@script, qq(print "ok $test\\n";\n));
     }
@@ -203,6 +193,99 @@ EOT
 
 test_broot(qw(-3 -2.1 0 0.99));
 
+sub test_display_format {
+    push @script, <<EOS;
+    my \$j = (root(1,3))[1];
+
+    \$j->display_format('polar');
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# display_format polar?\n";
+    print "not " unless \$j->display_format eq 'polar';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "[1,2pi/3]";
+    print "ok $test\n";
+
+    my %display_format;
+
+    %display_format = \$j->display_format;
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# display_format{style} polar?\n";
+    print "not " unless \$display_format{style} eq 'polar';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# keys %display_format == 2?\n";
+    print "not " unless keys %display_format == 2;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'cartesian', 'format' => '%.5f');
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "-0.50000+0.86603i";
+    print "ok $test\n";
+
+    %display_format = \$j->display_format;
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# display_format{format} %.5f?\n";
+    print "not " unless \$display_format{format} eq '%.5f';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# keys %display_format == 3?\n";
+    print "not " unless keys %display_format == 3;
+    print "ok $test\n";
+
+    \$j->display_format('format' => undef);
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" =~ /^-0(?:\\.5(?:0000\\d+)?|\\.49999\\d+)\\+0.86602540\\d+i\$/;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0);
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" =~ /^\\[1,2\\.09439510\\d+\\]\$/;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'cartesian', 'format' => '(%.5g)');
+EOS
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "(-0.5)+(0.86603)i";
+    print "ok $test\n";
+EOS
+}
+
+test_display_format();
+
 print "1..$test\n";
 eval join '', @script;
 die $@ if $@;
@@ -308,7 +391,7 @@ sub value {
 sub check {
        my ($test, $try, $got, $expected, @z) = @_;
 
-#      print "# @_\n";
+       print "# @_\n";
 
        if ("$got" eq "$expected"
            ||
@@ -387,6 +470,7 @@ __END__
 (1,0):(2,3):(1,0)
 (2,3):(0,0):(1,0)
 (2,3):(1,0):(2,3)
+(0,0):(0,0):(1,0)
 
 &Re
 (3,4):3
@@ -808,7 +892,7 @@ __END__
 ( 2,-3):(  1.96863792579310, -0.96465850440760)
 
 &acosh
-(-2.0,0):(  -1.31695789692482,  3.14159265358979)
+(-2.0,0):(   1.31695789692482,  3.14159265358979)
 (-1.0,0):(   0,                 3.14159265358979)
 (-0.5,0):(   0,                 2.09439510239320)
 ( 0.0,0):(   0,                 1.57079632679490)
@@ -818,8 +902,8 @@ __END__
 
 &acosh
 ( 2, 3):(  1.98338702991654,  1.00014354247380)
-(-2, 3):( -1.98338702991653, -2.14144911111600)
-(-2,-3):( -1.98338702991653,  2.14144911111600)
+(-2, 3):(  1.98338702991653,  2.14144911111600)
+(-2,-3):(  1.98338702991653, -2.14144911111600)
 ( 2,-3):(  1.98338702991654, -1.00014354247380)
 
 &atanh
@@ -838,15 +922,15 @@ __END__
 &asech
 (-2.0,0):(   0               , 2.09439510239320)
 (-1.0,0):(   0               , 3.14159265358979)
-(-0.5,0):(  -1.31695789692482, 3.14159265358979)
+(-0.5,0):(   1.31695789692482, 3.14159265358979)
 ( 0.5,0):(   1.31695789692482, 0               )
 ( 1.0,0):(   0               , 0               )
 ( 2.0,0):(   0               , 1.04719755119660)
 
 &asech
 ( 2, 3):(  0.23133469857397, -1.42041072246703)
-(-2, 3):( -0.23133469857397,  1.72118193112276)
-(-2,-3):( -0.23133469857397, -1.72118193112276)
+(-2, 3):(  0.23133469857397, -1.72118193112276)
+(-2,-3):(  0.23133469857397,  1.72118193112276)
 ( 2,-3):(  0.23133469857397,  1.42041072246703)
 
 &acsch
@@ -876,4 +960,3 @@ __END__
 ( 2,-3):(  0.14694666622553,  0.23182380450040)
 
 # eof
-