source: vendor/perl/5.8.8/lib/Math/Complex.t

Last change on this file was 3181, checked in by bird, 19 years ago

perl 5.8.8
File size: 28.4 KB
Line 
1#!./perl
2
3#
4# Regression tests for the Math::Complex pacakge
5# -- Raphael Manfredi since Sep 1996
6# -- Jarkko Hietaniemi since Mar 1997
7# -- Daniel S. Lewart since Sep 1997
8
9BEGIN {
10 if ($ENV{PERL_CORE}) {
11 chdir 't' if -d 't';
12 @INC = '../lib';
13 }
14}
15
16use Math::Complex;
17
18use vars qw($VERSION);
19
20$VERSION = 1.92;
21
22my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
23
24$test = 0;
25$| = 1;
26my @script = (
27 'my ($res, $s0,$s1,$s2,$s3,$s4,$s5,$s6,$s7,$s8,$s9,$s10,$z0,$z1,$z2);' .
28 "\n\n"
29);
30my $eps = 1e-13;
31
32if ($^O eq 'unicos') { # For some reason root() produces very inaccurate
33 $eps = 1e-10; # results in Cray UNICOS, and occasionally also
34} # cos(), sin(), cosh(), sinh(). The division
35 # of doubles is the current suspect.
36
37while (<DATA>) {
38 s/^\s+//;
39 next if $_ eq '' || /^\#/;
40 chomp;
41 $test_set = 0; # Assume not a test over a set of values
42 if (/^&(.+)/) {
43 $op = $1;
44 next;
45 }
46 elsif (/^\{(.+)\}/) {
47 set($1, \@set, \@val);
48 next;
49 }
50 elsif (s/^\|//) {
51 $test_set = 1; # Requests we loop over the set...
52 }
53 my @args = split(/:/);
54 if ($test_set == 1) {
55 my $i;
56 for ($i = 0; $i < @set; $i++) {
57 # complex number
58 $target = $set[$i];
59 # textual value as found in set definition
60 $zvalue = $val[$i];
61 test($zvalue, $target, @args);
62 }
63 } else {
64 test($op, undef, @args);
65 }
66}
67
68#
69
70sub test_mutators {
71 my $op;
72
73 $test++;
74push(@script, <<'EOT');
75{
76 my $z = cplx( 1, 1);
77 $z->Re(2);
78 $z->Im(3);
79 print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
80 print 'not ' unless Re($z) == 2 and Im($z) == 3;
81EOT
82 push(@script, qq(print "ok $test\\n"}\n));
83
84 $test++;
85push(@script, <<'EOT');
86{
87 my $z = cplx( 1, 1);
88 $z->abs(3 * sqrt(2));
89 print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
90 print 'not ' unless (abs($z) - 3 * sqrt(2)) < $eps and
91 (arg($z) - pi / 4 ) < $eps and
92 (Re($z) - 3 ) < $eps and
93 (Im($z) - 3 ) < $eps;
94EOT
95 push(@script, qq(print "ok $test\\n"}\n));
96
97 $test++;
98push(@script, <<'EOT');
99{
100 my $z = cplx( 1, 1);
101 $z->arg(-3 / 4 * pi);
102 print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
103 print 'not ' unless (arg($z) + 3 / 4 * pi) < $eps and
104 (abs($z) - sqrt(2) ) < $eps and
105 (Re($z) + 1 ) < $eps and
106 (Im($z) + 1 ) < $eps;
107EOT
108 push(@script, qq(print "ok $test\\n"}\n));
109}
110
111test_mutators();
112
113my $constants = '
114my $i = cplx(0, 1);
115my $pi = cplx(pi, 0);
116my $pii = cplx(0, pi);
117my $pip2 = cplx(pi/2, 0);
118my $pip4 = cplx(pi/4, 0);
119my $zero = cplx(0, 0);
120my $inf = 9**9**9;
121';
122
123push(@script, $constants);
124
125
126# test the divbyzeros
127
128sub test_dbz {
129 for my $op (@_) {
130 $test++;
131 push(@script, <<EOT);
132 eval '$op';
133 (\$bad) = (\$@ =~ /(.+)/);
134 print "# $test op = $op divbyzero? \$bad...\n";
135 print 'not ' unless (\$@ =~ /Division by zero/);
136EOT
137 push(@script, qq(print "ok $test\\n";\n));
138 }
139}
140
141# test the logofzeros
142
143sub test_loz {
144 for my $op (@_) {
145 $test++;
146 push(@script, <<EOT);
147 eval '$op';
148 (\$bad) = (\$@ =~ /(.+)/);
149 print "# $test op = $op logofzero? \$bad...\n";
150 print 'not ' unless (\$@ =~ /Logarithm of zero/);
151EOT
152 push(@script, qq(print "ok $test\\n";\n));
153 }
154}
155
156test_dbz(
157 'i/0',
158 'acot(0)',
159 'acot(+$i)',
160# 'acoth(-1)', # Log of zero.
161 'acoth(0)',
162 'acoth(+1)',
163 'acsc(0)',
164 'acsch(0)',
165 'asec(0)',
166 'asech(0)',
167 'atan($i)',
168# 'atanh(-1)', # Log of zero.
169 'atanh(+1)',
170 'cot(0)',
171 'coth(0)',
172 'csc(0)',
173 'csch(0)',
174 'atan(cplx(0, 1), cplx(1, 0))',
175 );
176
177test_loz(
178 'log($zero)',
179 'atan(-$i)',
180 'acot(-$i)',
181 'atanh(-1)',
182 'acoth(-1)',
183 );
184
185# test the bad roots
186
187sub test_broot {
188 for my $op (@_) {
189 $test++;
190 push(@script, <<EOT);
191 eval 'root(2, $op)';
192 (\$bad) = (\$@ =~ /(.+)/);
193 print "# $test op = $op badroot? \$bad...\n";
194 print 'not ' unless (\$@ =~ /root rank must be/);
195EOT
196 push(@script, qq(print "ok $test\\n";\n));
197 }
198}
199
200test_broot(qw(-3 -2.1 0 0.99));
201
202sub test_display_format {
203 $test++;
204 push @script, <<EOS;
205 print "# package display_format cartesian?\n";
206 print "not " unless Math::Complex->display_format eq 'cartesian';
207 print "ok $test\n";
208EOS
209
210 push @script, <<EOS;
211 my \$j = (root(1,3))[1];
212
213 \$j->display_format('polar');
214EOS
215
216 $test++;
217 push @script, <<EOS;
218 print "# j display_format polar?\n";
219 print "not " unless \$j->display_format eq 'polar';
220 print "ok $test\n";
221EOS
222
223 $test++;
224 push @script, <<EOS;
225 print "# j = \$j\n";
226 print "not " unless "\$j" eq "[1,2pi/3]";
227 print "ok $test\n";
228
229 my %display_format;
230
231 %display_format = \$j->display_format;
232EOS
233
234 $test++;
235 push @script, <<EOS;
236 print "# display_format{style} polar?\n";
237 print "not " unless \$display_format{style} eq 'polar';
238 print "ok $test\n";
239EOS
240
241 $test++;
242 push @script, <<EOS;
243 print "# keys %display_format == 2?\n";
244 print "not " unless keys %display_format == 2;
245 print "ok $test\n";
246
247 \$j->display_format('style' => 'cartesian', 'format' => '%.5f');
248EOS
249
250 $test++;
251 push @script, <<EOS;
252 print "# j = \$j\n";
253 print "not " unless "\$j" eq "-0.50000+0.86603i";
254 print "ok $test\n";
255
256 %display_format = \$j->display_format;
257EOS
258
259 $test++;
260 push @script, <<EOS;
261 print "# display_format{format} %.5f?\n";
262 print "not " unless \$display_format{format} eq '%.5f';
263 print "ok $test\n";
264EOS
265
266 $test++;
267 push @script, <<EOS;
268 print "# keys %display_format == 3?\n";
269 print "not " unless keys %display_format == 3;
270 print "ok $test\n";
271
272 \$j->display_format('format' => undef);
273EOS
274
275 $test++;
276 push @script, <<EOS;
277 print "# j = \$j\n";
278 print "not " unless "\$j" =~ /^-0(?:\\.5(?:0000\\d+)?|\\.49999\\d+)\\+0.86602540\\d+i\$/;
279 print "ok $test\n";
280
281 \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0);
282EOS
283
284 $test++;
285 push @script, <<EOS;
286 print "# j = \$j\n";
287 print "not " unless "\$j" =~ /^\\[1,2\\.09439510\\d+\\]\$/;
288 print "ok $test\n";
289
290 \$j->display_format('style' => 'cartesian', 'format' => '(%.5g)');
291EOS
292
293 $test++;
294 push @script, <<EOS;
295 print "# j = \$j\n";
296 print "not " unless "\$j" eq "(-0.5)+(0.86603)i";
297 print "ok $test\n";
298EOS
299
300 $test++;
301 push @script, <<EOS;
302 print "# j display_format cartesian?\n";
303 print "not " unless \$j->display_format eq 'cartesian';
304 print "ok $test\n";
305EOS
306}
307
308test_display_format();
309
310sub test_remake {
311 $test++;
312 push @script, <<EOS;
313 print "# remake 2+3i\n";
314 \$z = cplx('2+3i');
315 print "not " unless \$z == Math::Complex->make(2,3);
316 print "ok $test\n";
317EOS
318
319 $test++;
320 push @script, <<EOS;
321 print "# make 3i\n";
322 \$z = Math::Complex->make('3i');
323 print "not " unless \$z == cplx(0,3);
324 print "ok $test\n";
325EOS
326
327 $test++;
328 push @script, <<EOS;
329 print "# emake [2,3]\n";
330 \$z = Math::Complex->emake('[2,3]');
331 print "not " unless \$z == cplxe(2,3);
332 print "ok $test\n";
333EOS
334
335 $test++;
336 push @script, <<EOS;
337 print "# make (2,3)\n";
338 \$z = Math::Complex->make('(2,3)');
339 print "not " unless \$z == cplx(2,3);
340 print "ok $test\n";
341EOS
342
343 $test++;
344 push @script, <<EOS;
345 print "# emake [2,3pi/8]\n";
346 \$z = Math::Complex->emake('[2,3pi/8]');
347 print "not " unless \$z == cplxe(2,3*\$pi/8);
348 print "ok $test\n";
349EOS
350
351 $test++;
352 push @script, <<EOS;
353 print "# emake [2]\n";
354 \$z = Math::Complex->emake('[2]');
355 print "not " unless \$z == cplxe(2);
356 print "ok $test\n";
357EOS
358}
359
360sub test_no_args {
361 push @script, <<'EOS';
362{
363 print "# cplx, cplxe, make, emake without arguments\n";
364EOS
365
366 $test++;
367 push @script, <<EOS;
368 my \$z0 = cplx();
369 print ((\$z0->Re() == 0) ? "ok $test\n" : "not ok $test\n");
370EOS
371
372 $test++;
373 push @script, <<EOS;
374 print ((\$z0->Im() == 0) ? "ok $test\n" : "not ok $test\n");
375EOS
376
377 $test++;
378 push @script, <<EOS;
379 my \$z1 = cplxe();
380 print ((\$z1->rho() == 0) ? "ok $test\n" : "not ok $test\n");
381EOS
382
383 $test++;
384 push @script, <<EOS;
385 print ((\$z1->theta() == 0) ? "ok $test\n" : "not ok $test\n");
386EOS
387
388 $test++;
389 push @script, <<EOS;
390 my \$z2 = Math::Complex->make();
391 print ((\$z2->Re() == 0) ? "ok $test\n" : "not ok $test\n");
392EOS
393
394 $test++;
395 push @script, <<EOS;
396 print ((\$z2->Im() == 0) ? "ok $test\n" : "not ok $test\n");
397EOS
398
399 $test++;
400 push @script, <<EOS;
401 my \$z3 = Math::Complex->emake();
402 print ((\$z3->rho() == 0) ? "ok $test\n" : "not ok $test\n");
403EOS
404
405 $test++;
406 push @script, <<EOS;
407 print ((\$z3->theta() == 0) ? "ok $test\n" : "not ok $test\n");
408}