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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
# -*- Mode: CPerl -*-
# File: t/common.plt
# Description: re-usable test subs; requires Test::More
BEGIN { $| = 1; }
# isok($label,@_) -- prints helpful label
sub isok {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $label = shift;
if (@_==1) {
ok($_[0],$label);
} elsif (@_==2) {
is($_[0],$_[1], $label);
} else {
die("isok(): expected 1 or 2 non-label arguments, but got ", scalar(@_));
}
}
# skipok($label,$skip_if_true,@_) -- prints helpful label
# skipok($label,$skip_if_true,\&CODE) -- prints helpful label
sub skipok {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($label,$skip_if_true) = splice(@_,0,2);
if ($skip_if_true) {
subtest $label => sub { plan skip_all => $skip_if_true; };
} else {
if (@_==1 && ref($_[0]) && ref($_[0]) eq 'CODE') {
isok($label, $_[0]->());
} else {
isok($label,@_);
}
}
}
# skipordo($label,$skip_if_true,sub { ok ... },@args_for_sub)
sub skipordo {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($label,$skip_if_true) = splice(@_,0,2);
if ($skip_if_true) {
subtest $label => sub { plan skip_all => $skip_if_true; };
} else {
$_[0]->(@_[1..$#_]);
}
}
# ulistok($label,\@got,\@expect)
# --> ok() for unsorted lists
sub ulistok {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($label,$l1,$l2) = @_;
is_deeply([sort @$l1],[sort @$l2],$label);
}
# matchpdl($a,$b) : returns pdl identity check, including BAD
sub matchpdl {
my ($a,$b) = map {PDL->topdl($_)->setnantobad} @_[0,1];
return ($a==$b)->setbadtoval(0) | ($a->isbad & $b->isbad) | ($a->isfinite->not & $b->isfinite->not);
}
# matchpdl($a,$b,$eps) : returns pdl approximation check, including BAD
sub matchpdla {
my ($a,$b) = map {$_->setnantobad} @_[0,1];
my $eps = $_[2];
$eps = 1e-5 if (!defined($eps));
return $a->approx($b,$eps)->setbadtoval(0) | ($a->isbad & $b->isbad) | ($a->isfinite->not & $b->isfinite->not);
}
# cmp_dims($got_pdl,$expect_pdl)
sub cmp_dims {
my ($p1,$p2) = @_;
return $p1->ndims==$p2->ndims && all(pdl(PDL::long(),[$p1->dims])==pdl(PDL::long(),[$p2->dims]));
}
# pdlok($label, $got, $want)
sub pdlok {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($label,$got,$want) = @_;
$got = PDL->topdl($got) if (defined($got));
$want = PDL->topdl($want) if (defined($want));
isok($label,
defined($got) && defined($want)
&& cmp_dims($got,$want)
&& all(matchpdl($want,$got))) or diag "got=$got\nwant=$want";
}
# pdlok_nodims($label, $got, $want)
# + ignores dimensions
sub pdlok_nodims {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($label,$got,$want) = @_;
$got = PDL->topdl($got) if (defined($got));
$want = PDL->topdl($want) if (defined($want));
isok($label,
defined($got) && defined($want)
#&& cmp_dims($got,$want)
&& all(matchpdl($want,$got)));
}
# pdlapprox($label, $got, $want, $eps=1e-5)
sub pdlapprox {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($label,$got,$want,$eps) = @_;
$got = PDL->topdl($got) if (defined($got));
$want = PDL->topdl($want) if (defined($want));
$eps = 1e-5 if (!defined($eps));
isok($label,
defined($got) && defined($want)
&& cmp_dims($got,$want)
&& all(matchpdla($want,$got,$eps)))
or diag "got=$got\nwant=$want";
}
print "loaded ", __FILE__, "\n";
1;
|
