1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
use PDL::LiteF;
use PDL::Complex;
use PDL::Config;
sub ok {
my $no = shift ;
my $result = shift ;
print "not " unless $result ;
print "ok $no\n" ;
}
sub tapprox {
my($a,$b) = @_;
my $c = abs($a-$b);
my $d = max($c);
$d < 0.0001;
}
# more tests required; anybody?
print "1..13\n";
$testNo = 1;
$ref = pdl([[-2,1],[-3,1]]);
$a = i - pdl(2,3);
ok($testNo++, ref $a eq PDL::Complex);
ok($testNo++,tapprox($a->real,$ref));
$a = pdl(2,3) - i;
ok($testNo++, ref $a eq PDL::Complex);
ok($testNo++,tapprox($a->real,-$ref));
# dataflow from complex to real
$ar = $a->real;
$ar++;
ok($testNo++,tapprox($a->real, -$ref+1));
# Check that converting from re/im to mag/ang and
# back we get the same thing
$a = cplx($ref);
my $b = $a->Cr2p()->Cp2r();
ok($testNo++, tapprox($a-$b, 0));
# to test Cabs, Cabs2, Carg (ref PDL)
# Catan, Csinh, Ccosh, Catanh, Croots
$cabs = sqrt($a->re**2+$a->im**2);
ok($testNo++, ref Cabs $a eq 'PDL');
ok($testNo++, ref Cabs2 $a eq 'PDL');
ok($testNo++, ref Carg $a eq 'PDL');
ok($testNo++, tapprox($cabs, Cabs $a));
ok($testNo++, tapprox($cabs**2, Cabs2 $a));
# Check cat'ing of PDL::Complex
# This was broken before Mar-06 in CVS, due
# to a bug in PDL::Complex::initialize
$b = $a->copy + 1;
my $bigArray = $a->cat($b);
ok($testNo++, abs($bigArray->sum() + 8 - 4*i) < .0001 );
SKIP: {
if ($PDL::Config{SKIP_KNOWN_PROBLEMS} or exists $ENV{SKIP_KNOWN_PROBLEMS} ) {
print "# skipping test $testNo, sf.net bug #1176614 test\n";
ok($testNo++, 1);
last SKIP;
}
# Check stringification of complex piddle
# This is sf.net bug #1176614
my $c = 9.1234 + 4.1234*i;
my $c211 = $c->dummy(2,1);
my $c211str = "$c211";
ok($testNo++, $c211str=~/(9.123|4.123)/);
}
|
