Skip to content

Commit 2c74fbc

Browse files
committed
zap approx from t/{math,matrix,ops}.t - #34
1 parent ec40ee4 commit 2c74fbc

File tree

4 files changed

+124
-190
lines changed

4 files changed

+124
-190
lines changed

lib/PDL/Ops.pd

+1-1
Original file line numberDiff line numberDiff line change
@@ -465,7 +465,7 @@ raise ndarray C<\$a> to integer power C<\$b>
465465
Algorithm from L<Wikipedia|http://en.wikipedia.org/wiki/Exponentiation_by_squaring>
466466
},
467467
Pars => 'a(); longlong b(); [o] ans()',
468-
GenericTypes => $AF,
468+
GenericTypes => $A,
469469
Code => pp_line_numbers(__LINE__-1, q{
470470
$GENERIC(b) n = $b();
471471
if (n == 0) {

t/math.t

+17-17
Original file line numberDiff line numberDiff line change
@@ -59,36 +59,36 @@ like $@, qr/only works/, 'polyroots(1,0) throws exception not segfault';
5959
my $coeffs = pdl(cdouble, 1,-55,1320,-18150,157773,-902055, 3416930,-8409500,12753576,-10628640,3628800);
6060
my $roots = 1+sequence(10);
6161
my $got;
62-
ok all(approx $got=qsort((polyroots $coeffs->re, $coeffs->im)[0]), $roots), 'polyroots' or diag $got;
62+
is_pdl qsort((polyroots $coeffs->re, $coeffs->im)[0]), $roots, 'polyroots';
6363
polyroots $coeffs->re, $coeffs->im, $got=null; $got->inplace->qsort;
64-
ok all(approx $got, $roots), 'polyroots with explicit output args' or diag $got;
65-
ok all(approx $got=qsort(polyroots($coeffs)->re), $roots), 'polyroots native complex no output args' or diag $got;
64+
is_pdl $got, $roots, 'polyroots with explicit output args';
65+
is_pdl qsort(polyroots($coeffs)->re), $roots, 'polyroots native complex no output args';
6666
polyroots $coeffs, $got=null; $got=$got->re->qsort;
67-
ok all(approx $got, $roots), 'polyroots native complex explicit output args' or diag $got;
67+
is_pdl $got, $roots, 'polyroots native complex explicit output args';
6868
eval {polyroots(pdl("[1 0 0 0 -1]"),zeroes(5))};
6969
is $@, '', 'polyroots no crash on 4 complex roots of 1';
70-
ok all(approx $got=(polyfromroots $roots, $roots->zeroes)[0], $coeffs->re), 'polyfromroots legacy no outargs' or diag $got;
70+
is_pdl +(polyfromroots $roots, $roots->zeroes)[0], $coeffs->re, 'polyfromroots legacy no outargs';
7171
polyfromroots $roots, $roots->zeroes, $got=null;
72-
ok all(approx $got, $coeffs->re), 'polyfromroots legacy with explicit output args' or diag $got;
73-
ok all(approx $got=polyfromroots(cdouble($roots)), $coeffs->re), 'polyfromroots natcom no outargs' or diag $got;
72+
is_pdl $got, $coeffs->re, 'polyfromroots legacy with explicit output args';
73+
is_pdl polyfromroots(cdouble($roots)), $coeffs, 'polyfromroots natcom no outargs';
7474
polyfromroots cdouble($roots), $got=null;
75-
ok all(approx $got, $coeffs), 'polyfromroots natcom explicit outargs' or diag $got;
75+
is_pdl $got, $coeffs, 'polyfromroots natcom explicit outargs';
7676

7777
my ($coeffs2, $x, $exp_val) = (cdouble(3,2,1), cdouble(5,7,9), cdouble(86,162,262));
78-
ok all(approx $got=polyval($coeffs2, $x), $exp_val), 'polyval natcom no output' or diag $got;
78+
is_pdl polyval($coeffs2, $x), $exp_val, 'polyval natcom no output';
7979
polyval($coeffs2, $x, $got=null);
80-
ok all(approx $got, $exp_val), 'polyval natcom explicit output' or diag $got;
81-
ok all(approx $got=(polyval($coeffs2->re, zeroes(3), $x->re, zeroes(3)))[0], $exp_val->re), 'polyval legacy no output' or diag $got;
80+
is_pdl $got, $exp_val, 'polyval natcom explicit output';
81+
is_pdl +(polyval($coeffs2->re, zeroes(3), $x->re, zeroes(3)))[0], $exp_val->re, 'polyval legacy no output';
8282
polyval($coeffs2->re, zeroes(3), $x->re, zeroes(3), $got=null);
83-
ok all(approx $got, $exp_val->re), 'polyval legacy explicit output' or diag $got;
83+
is_pdl $got, $exp_val->re, 'polyval legacy explicit output';
8484

8585
{
8686
my $pa = sequence(41) - 20;
8787
$pa /= 4;
8888
#do test on quarter-integers, to make sure we're not crazy.
8989
my $ans_rint = pdl(-5,-5,-4,-4,-4,-4,-4,-3,-3,-3,-2,-2,-2,-2,-2,
9090
-1,-1,-1,0,0,0,0,0,1,1,1,2,2,2,2,2,3,3,3,4,4,4,4,4,5,5);
91-
ok(all(rint($pa)==$ans_rint),"rint");
91+
is_pdl rint($pa), $ans_rint, "rint";
9292
}
9393

9494
is_pdl sinh(0.3), pdl(0.3045), "sinh";
@@ -108,11 +108,11 @@ is_pdl $pa, pdl(0.3045), "sinh inplace";
108108
if ($Config{cc} ne 'cl') {
109109
# lgamma not implemented for MS compilers
110110
my @x = lgamma(-0.1);
111-
is(approx($x[0], 2.36896133272879), 1);
112-
is($x[1], -1);
111+
is_pdl $x[0], pdl(2.36896133272879);
112+
is $x[1], -1;
113113
@x = lgamma(1.1);
114-
is(approx($x[0], -0.0498724412598397), 1);
115-
is($x[1], 1);
114+
is_pdl $x[0], pdl(-0.0498724412598397);
115+
is $x[1], 1;
116116
my $p = sequence (1);
117117
$p->badvalue (0);
118118
$p->badflag (1);

t/matrix.t

+8-9
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ use warnings;
33

44
use PDL::LiteF;
55
use Test::More;
6+
use Test::PDL;
67

78
use PDL::Matrix;
89
use PDL::MatrixOps;
@@ -11,11 +12,11 @@ my $m = mpdl([[1,2,1],[2,0,3],[1,1,1]]); # matrix with determinant 1
1112

1213
my $tol = 1e-6;
1314
note "determinant: ",$m->det;
14-
ok approx($m->det, 1, $tol), "det" or diag 'got: ', $m->det;
15-
ok approx($m->determinant, 1, $tol), "determinant";
15+
is_pdl $m->det, pdl(1), "det";
16+
is_pdl $m->determinant, pdl(1), "determinant";
1617

17-
is ref(identity($m)), 'PDL::Matrix', 'identity of mpdl right class';
18-
is ref(my $from_scalar = identity(vpdl 3)), 'PDL::Matrix', 'identity of mpdl right class';
18+
isa_ok identity($m), 'PDL::Matrix', 'identity of mpdl right class';
19+
isa_ok my $from_scalar = identity(vpdl 3), 'PDL::Matrix', 'identity of mpdl right class';
1920
is $from_scalar.'', <<EOF, 'from scalar';
2021
\n[
2122
[1 0 0]
@@ -27,14 +28,12 @@ EOF
2728
my $v = vpdl [1..3];
2829
my $gotfunc = inv($m);
2930
my $gotfuncmul = $gotfunc x $v;
30-
my $expected = vpdl('[13 -2 -8]');
31+
my $expected = vpdl('[[13 -2 -8]]');
3132
isa_ok $gotfunc, 'PDL::Matrix', 'inv($mpdl) right class';
32-
ok all(approx $gotfuncmul, $expected, $tol), 'inv($mpdl) mult correct'
33-
or diag "gotfuncmul=",ref($gotfuncmul),":", $gotfuncmul,
34-
"expected=",ref($gotfuncmul),":", $expected;
33+
is_pdl $gotfuncmul, $expected, 'inv($mpdl) mult correct';
3534
my $gotmeth = $m->inv;
3635
my $gotmethmul = $gotmeth x $v;
3736
isa_ok $gotmeth, 'PDL::Matrix', '$mpdl->inv right class';
38-
ok all(approx $gotmethmul, $expected, $tol), '$mpdl->inv mult correct';
37+
is_pdl $gotmethmul, $expected, '$mpdl->inv mult correct';
3938

4039
done_testing;

0 commit comments

Comments
 (0)