t/lib/complex.t

   1 #!./perl
   2
   3 # $RCSfile$
   4 #
   5 # Regression tests for the new Math::Complex pacakge
   6 # -- Raphael Manfredi, Sept 1996
   7 BEGIN {
   8     chdir 't' if -d 't';
   9     @INC = '../lib';
  10 }
  11 use Math::Complex;
  12
  13 $test = 0;
  14 $| = 1;
  15 $script = '';
  16 $epsilon = 1e-10;
  17
  18 while (<DATA>) {
  19         next if /^#/ || /^\s*$/;
  20         chop;
  21         $set_test = 0;                  # Assume not a test over a set of values
  22         if (/^&(.*)/) {
  23                 $op = $1;
  24                 next;
  25         }
  26         elsif (/^\{(.*)\}/) {
  27                 set($1, \@set, \@val);
  28                 next;
  29         }
  30         elsif (s/^\|//) {
  31                 $set_test = 1;          # Requests we loop over the set...
  32         }
  33         my @args = split(/:/);
  34         if ($set_test) {
  35                 my $i;
  36                 for ($i = 0; $i < @set; $i++) {
  37                         $target = $set[$i];             # complex number
  38                         $zvalue = $val[$i];             # textual value as found in set definition
  39                         test($zvalue, $target, @args);
  40                 }
  41         } else {
  42                 test($op, undef, @args);
  43         }
  44 }
  45
  46 print "1..$test\n";
  47 eval $script;
  48 die $@ if $@;
  49
  50 sub test {
  51         my ($op, $z, @args) = @_;
  52         $test++;
  53         my $i;
  54         for ($i = 0; $i < @args; $i++) {
  55                 $val = value($args[$i]);
  56                 $script .= "\$z$i = $val;\n";
  57         }
  58         if (defined $z) {
  59                 $args = "'$op'";                # Really the value
  60                 $try = "abs(\$z0 - \$z1) <= 1e-10 ? \$z1 : \$z0";
  61                 $script .= "\$res = $try; ";
  62                 $script .= "check($test, $args[0], \$res, \$z$#args, $args);\n";
  63         } else {
  64                 my ($try, $args);
  65                 if (@args == 2) {
  66                         $try = "$op \$z0";
  67                         $args = "'$args[0]'";
  68                 } else {
  69                         $try = ($op =~ /^\w/) ? "$op(\$z0, \$z1)" : "\$z0 $op \$z1";
  70                         $args = "'$args[0]', '$args[1]'";
  71                 }
  72                 $script .= "\$res = $try; ";
  73                 $script .= "check($test, '$try', \$res, \$z$#args, $args);\n";
  74         }
  75 }
  76
  77 sub set {
  78         my ($set, $setref, $valref) = @_;
  79         @{$setref} = ();
  80         @{$valref} = ();
  81         my @set = split(/;\s*/, $set);
  82         my @res;
  83         my $i;
  84         for ($i = 0; $i < @set; $i++) {
  85                 push(@{$valref}, $set[$i]);
  86                 my $val = value($set[$i]);
  87                 $script .= "\$s$i = $val;\n";
  88                 push(@{$setref}, "\$s$i");
  89         }
  90 }
  91
  92 sub value {
  93         local ($_) = @_;
  94         if (/^\s*\((.*),(.*)\)/) {
  95                 return "cplx($1,$2)";
  96         }
  97         elsif (/^\s*\[(.*),(.*)\]/) {
  98                 return "cplxe($1,$2)";
  99         }
 100         elsif (/^\s*'(.*)'/) {
 101                 my $ex = $1;
 102                 $ex =~ s/\bz\b/$target/g;
 103                 $ex =~ s/\br\b/abs($target)/g;
 104                 $ex =~ s/\bt\b/arg($target)/g;
 105                 $ex =~ s/\ba\b/Re($target)/g;
 106                 $ex =~ s/\bb\b/Im($target)/g;
 107                 return $ex;
 108         }
 109         elsif (/^\s*"(.*)"/) {
 110                 return "\"$1\"";
 111         }
 112         return $_;
 113 }
 114
 115 sub check {
 116         my ($test, $try, $got, $expected, @z) = @_;
 117         if ("$got" eq "$expected" || ($expected =~ /^-?\d/ && $got == $expected)) {
 118                 print "ok $test\n";
 119         } else {
 120                 print "not ok $test\n";
 121                 my $args = (@z == 1) ? "z = $z[0]" : "z0 = $z[0], z1 = $z[1]";
 122                 print "# '$try' expected: '$expected' got: '$got' for $args\n";
 123         }
 124 }
 125 __END__
 126 &+
 127 (3,4):(3,4):(6,8)
 128 (-3,4):(3,-4):(0,0)
 129 (3,4):-3:(0,4)
 130 1:(4,2):(5,2)
 131 [2,0]:[2,pi]:(0,0)
 132
 133 &++
 134 (2,1):(3,1)
 135
 136 &-
 137 (2,3):(-2,-3)
 138 [2,pi/2]:[2,-(pi)/2]
 139 2:[2,0]:(0,0)
 140 [3,0]:2:(1,0)
 141 3:(4,5):(-1,-5)
 142 (4,5):3:(1,5)
 143
 144 &--
 145 (1,2):(0,2)
 146 [2,pi]:[3,pi]
 147
 148 &*
 149 (0,1):(0,1):(-1,0)
 150 (4,5):(1,0):(4,5)
 151 [2,2*pi/3]:(1,0):[2,2*pi/3]
 152 2:(0,1):(0,2)
 153 (0,1):3:(0,3)
 154 (0,1):(4,1):(-1,4)
 155 (2,1):(4,-1):(9,2)
 156
 157 &/
 158 (3,4):(3,4):(1,0)
 159 (4,-5):1:(4,-5)
 160 1:(0,1):(0,-1)
 161 (0,6):(0,2):(3,0)
 162 (9,2):(4,-1):(2,1)
 163 [4,pi]:[2,pi/2]:[2,pi/2]
 164 [2,pi/2]:[4,pi]:[0.5,-(pi)/2]
 165
 166 &abs
 167 (3,4):5
 168 (-3,4):5
 169
 170 &~
 171 (4,5):(4,-5)
 172 (-3,4):(-3,-4)
 173 [2,pi/2]:[2,-(pi)/2]
 174
 175 &<
 176 (3,4):(1,2):0
 177 (3,4):(3,2):0
 178 (3,4):(3,8):1
 179 (4,4):(5,129):1
 180
 181 &==
 182 (3,4):(4,5):0
 183 (3,4):(3,5):0
 184 (3,4):(2,4):0
 185 (3,4):(3,4):1
 186
 187 &sqrt
 188 (-100,0):(0,10)
 189 (16,-30):(5,-3)
 190
 191 &stringify_cartesian
 192 (-100,0):"-100"
 193 (0,1):"i"
 194 (4,-3):"4-3i"
 195 (4,0):"4"
 196 (-4,0):"-4"
 197 (-2,4):"-2+4i"
 198 (-2,-1):"-2-i"
 199
 200 &stringify_polar
 201 [-1, 0]:"[1,pi]"
 202 [1, pi/3]:"[1,pi/3]"
 203 [6, -2*pi/3]:"[6,-2pi/3]"
 204 [0.5, -9*pi/11]:"[0.5,-9pi/11]"
 205
 206 { (4,3); [3,2]; (-3,4); (0,2); [2,1] }
 207
 208 |'z + ~z':'2*Re(z)'
 209 |'z - ~z':'2*i*Im(z)'
 210 |'z * ~z':'abs(z) * abs(z)'
 211
 212 { (4,3); [3,2]; (-3,4); (0,2); 3; 1; (-5, 0); [2,1] }
 213
 214 |'exp(z)':'exp(a) * exp(i * b)'
 215 |'abs(z)':'r'
 216 |'sqrt(z) * sqrt(z)':'z'
 217 |'sqrt(z)':'sqrt(r) * exp(i * t/2)'
 218 |'cbrt(z)':'cbrt(r) * exp(i * t/3)'
 219 |'log(z)':'log(r) + i*t'
 220 |'sin(asin(z))':'z'
 221 |'cos(acos(z))':'z'
 222 |'tan(atan(z))':'z'
 223 |'cotan(acotan(z))':'z'
 224 |'cos(z) ** 2 + sin(z) ** 2':1
 225 |'cosh(z) ** 2 - sinh(z) ** 2':1
 226 |'cos(z)':'cosh(i*z)'
 227 |'cotan(z)':'1 / tan(z)'
 228 |'cotanh(z)':'1 / tanh(z)'
 229 |'i*sin(z)':'sinh(i*z)'
 230 |'z**z':'exp(z * log(z))'
 231 |'log(exp(z))':'z'
 232 |'exp(log(z))':'z'
 233 |'log10(z)':'log(z) / log(10)'
 234 |'logn(z, 3)':'log(z) / log(3)'
 235 |'logn(z, 2)':'log(z) / log(2)'
 236 |'(root(z, 4))[1] ** 4':'z'
 237 |'(root(z, 8))[7] ** 8':'z'
 238
 239 { (1,1); [1,0.5]; (-2, -1); 2; (-1,0.5); (0,0.5); 0.5; (2, 0) }
 240
 241 |'sinh(asinh(z))':'z'
 242 |'cosh(acosh(z))':'z'
 243 |'tanh(atanh(z))':'z'
 244 |'cotanh(acotanh(z))':'z'
 245
 246 { (0.2,-0.4); [1,0.5]; -1.2; (-1,0.5); (0,-0.5); 0.5; (1.1, 0) }
 247
 248 |'asin(sin(z))':'z'
 249 |'acos(cos(z)) ** 2':'z * z'
 250 |'atan(tan(z))':'z'
 251 |'asinh(sinh(z))':'z'
 252 |'acosh(cosh(z)) ** 2':'z * z'
 253 |'atanh(tanh(z))':'z'
 254