t/primitive-*.t replace tapprox with is_pdl - #34

Basic/TestPDL.pm

@@ -193,8 +193,9 @@ sub is_pdl {
   if (defined $mask) {
     my $coords = defined $mask ? $mask->not->whichND : undef;
     $coords = $coords->slice(',0:4') if defined $coords and $coords->dim(1) > 5;
+    my $cstr = $coords->string; $cstr =~ s#\n+\z##;
     push @mismatch, (
-      "\nFirst <=5 values differ at:", $coords,
+      "\nFirst <=5 values differ at: $cstr\n",
       "Those 'got' values: ", $got->indexND($coords),
       "\nThose 'expected' values: ", $expected->indexND($coords),
     );

Basic/t/basic.t

@@ -4,12 +4,6 @@ use Test::More;
 use PDL::LiteF;
 use Test::PDL;
 
-sub tapprox {
-    my($x,$y) = @_;
-    my $d = max( abs($x-$y) );
-    $d < 1.0e-6;
-}
-
 my $x0 = pdl( [ 2, 1, 2 ], [ 1, 0, 1 ], [ 2, 1, 2 ] );
 is_pdl rvals(3,3), $x0->sqrt, "centered rvals";
 is_pdl rvals(3,3,{squared=>1}), $x0, "centered rvals squared";

Basic/t/primitive-matmult.t

@@ -2,9 +2,8 @@ use strict;
 use warnings;
 use Test::More;
 use Test::Exception;
+use Test::PDL;
 use PDL::LiteF;
-use lib 't/lib';
-use My::Test::Primitive;
 
 # provide independent copies of test data.
 sub IM {
@@ -26,7 +25,7 @@ subtest 'complex' => sub {
     # complex matmult
     my $cm1 = pdl('1 1+i 1');
     my $cm2 = pdl('2 3 i')->transpose;
-    ok tapprox( $cm1 x $cm2, pdl('[[5+4i]]') ), 'complex matmult';
+    is_pdl $cm1 x $cm2, pdl('[[5+4i]]'), 'complex matmult';
     throws_ok { scalar $cm1->transpose x $cm2 }
       qr/mismatch/,
       'good error on mismatch matmult';
@@ -39,32 +38,32 @@ sub EQ { float [ [ 1, 1, 1, 1 ] ] }
 
 subtest 'test fiducials: 3x4 x 4x2' => sub {
 
-    ok tapprox( PA() x PB(), PC() );
+    is_pdl PA() x PB(), PC();
 
     matmult( PA, PB, my $res = null );
-    ok tapprox( $res, PC ), 'res=null';
+    is_pdl $res, PC, 'res=null';
 };
 
 subtest 'sliced input' => sub {
     my $pa_sliced =
       PA->dummy( 0, 3 )->dummy( -1, 3 )->make_physical->slice('(1),,,(1)');
-    ok tapprox( PC, $pa_sliced x PB );
+    is_pdl $pa_sliced x PB, PC;
 };
 
 subtest 'output = zeroes(2,3)' => sub {
     my $res = zeroes( 2, 3 );
     matmult( PA, PB, $res );
-    ok tapprox( PC, $res ), 'res=zeroes';
+    is_pdl $res, PC, 'res=zeroes';
 };
 
 subtest 'output = ones(2,3)' => sub {
     my $res = ones( 2, 3 );
     matmult( PA, PB, $res );
-    ok tapprox( PC, $res ), 'res=ones';
+    is_pdl $res, PC, 'res=ones';
 };
 
-# Check collapse: output should be a 1x2...
-ok tapprox( EQ() x PB(), pdl( [ [ 2, 6 ] ] ) ), '([4x1] x [2x4] -> [1x2])';
+# Check collapse: output should be a 2x1...
+is_pdl EQ() x PB(), pdl( [ [ 2, 6 ] ] ), '([4x1] x [2x4] -> [2x1])';
 
 # Check dimensional exception: mismatched dims should throw an error
 throws_ok {
@@ -73,25 +72,24 @@ throws_ok {
     qr/mismatch in matmult/,
     '[2x4] x [4x1] --> error (2 != 1)';
 
-ok tapprox( PB() x 2, PB() * 2, 'ndarray x Perl scalar' );
-
-ok tapprox( pdl(3) x PB(), PB() *3 ), '1D ndarray x ndarray';
+is_pdl PB() x 2, PB() * 2, 'ndarray x Perl scalar';
+is_pdl pdl(3) x PB(), PB() *3, '1D ndarray x ndarray';
 
 subtest 'nans' => sub {
   my $A = pdl '[1 nan 0; 0 1 0; 0 0 1]';
   my $B = PDL->sequence(2,3);
   my $C = $A x $B;
   $C->inplace->setnantobad;
   $C->inplace->setbadtoval(6);
-  ok tapprox($C, pdl '[6 6; 2 3; 4 5]');
+  is_pdl $C, pdl '[6 6; 2 3; 4 5]';
 };
 
 subtest 'badvals' => sub {
   my $A = pdl '[1 BAD 0; 0 1 0; 0 0 1]';
   my $B = PDL->sequence(2,3);
   my $C = $A x $B;
   $C->inplace->setbadtoval(6);
-  ok tapprox($C, pdl '[6 6; 2 3; 4 5]');
+  is_pdl $C, pdl '[6 6; 2 3; 4 5]';
 };
 
 done_testing;

Basic/t/primitive-misc.t

@@ -1,38 +1,31 @@
 use Test::More;
 use PDL::LiteF;
 use PDL::Types;
-
-use lib 't/lib';
-use My::Test::Primitive;
+use Test::PDL;
 
 subtest hist => sub {
   my $y = pdl( 0.7422, 0.0299, 0.6629, 0.9118, 0.1224, 0.6173, 0.9203, 0.9999,
     0.1480, 0.4297, 0.5000, 0.9637, 0.1148, 0.2922, 0.0846, 0.0954, 0.1379,
     0.3187, 0.1655, 0.5777, 0.3047 );
-  is $y->hist(0, 1, 0.1).'', "[3 5 1 2 1 2 2 1 0 4]", 'hist works';
+  is_pdl scalar $y->hist(0, 1, 0.1), pdl("3 5 1 2 1 2 2 1 0 4"), 'hist works';
 };
 
 subtest norm => sub {
-
     my $x = pdl('[[i 2+3i] [4+5i 6+7i]]');
-    ok tapprox $x->norm,
+    is_pdl $x->norm,
       pdl(
         [
             [ 0.267261 * i,            0.534522 + 0.801783 * i ],
             [ 0.356348 + 0.445435 * i, 0.534522 + 0.623609 * i ],
         ]
       ),
-      'native complex norm works'
-      or diag $x->norm;
-
+      'native complex norm works';
 };
 
 subtest glue => sub {
-
     my $x = xvals( 2, 2, 2 );
     my $y = yvals( 2, 2, 2 );
     my $c = zvals( 2, 2, 2 );
-
     is_deeply $x->glue( 1, $y, $c )->unpdl,
       [
         [ [ 0, 1 ], [ 0, 1 ], [ 0, 0 ], [ 1, 1 ], [ 0, 0 ], [ 0, 0 ] ],
@@ -41,27 +34,24 @@ subtest glue => sub {
 };
 
 subtest 'fibonacci' => sub {
-    my $fib = fibonacci(15);
-    my $fib_ans =
-      pdl( 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610 );
-    ok tapprox( $fib, $fib_ans ), 'Fibonacci sequence';
+    is_pdl fibonacci(15), indx('1 1 2 3 5 8 13 21 34 55 89 144 233 377 610'), 'Fibonacci sequence';
 };
 
 subtest 'indadd' => sub {
     my $a1  = pdl( 1, 2, 3 );
     my $ind = pdl( 1, 4, 6 );
     my $sum = zeroes(10);
     indadd( $a1, $ind, $sum );
-    ok( tapprox( $sum->sum, 6 ), "indadd" );
+    is_pdl $sum->sum, pdl(6), "indadd";
 };
 
 subtest 'one2nd' => sub {
     my $a1      = zeroes( 3, 4, 5 );
     my $indices = pdl( 0, 1, 4, 6, 23, 58, 59 );
     my ( $x, $y, $z ) = $a1->one2nd($indices);
-    ok tapprox( $x, pdl( 0, 1, 1, 0, 2, 1, 2 ) ), "one2nd x";
-    ok tapprox( $y, pdl( 0, 0, 1, 2, 3, 3, 3 ) ), "one2nd y";
-    ok tapprox( $z, pdl( 0, 0, 0, 0, 1, 4, 4 ) ), "one2nd z";
+    is_pdl $x, indx( 0, 1, 1, 0, 2, 1, 2 ), "one2nd x";
+    is_pdl $y, indx( 0, 0, 1, 2, 3, 3, 3 ), "one2nd y";
+    is_pdl $z, indx( 0, 0, 0, 0, 1, 4, 4 ), "one2nd z";
 };
 
 subtest approx_artol => sub {

Basic/t/primitive-random.t

@@ -3,8 +3,7 @@ use warnings;
 use Test::More;
 use Test::Exception;
 use PDL::LiteF;
-use lib 't/lib';
-use My::Test::Primitive;
+use Test::PDL;
 
 TODO: { local $TODO = 'Some CPAN Testers fails for OpenBSD'; subtest 'random' => sub {
 
@@ -16,15 +15,15 @@ TODO: { local $TODO = 'Some CPAN Testers fails for OpenBSD'; subtest 'random' =>
         my $r1 = random 10;
         srandom 5;
         my $r2 = random 10;
-        ok( tapprox( $r1, $r2 ), "random and srandom" );
+        is_pdl $r1, $r2, "random and srandom";
     };
 
     subtest 'grandom and srandom' => sub {
         srandom 10;
         my $r1 = grandom 10;
         srandom 10;
         my $r2 = grandom 10;
-        ok( tapprox( $r1, $r2 ), "grandom and srandom" );
+        is_pdl $r1, $r2, "grandom and srandom";
     };
 }; }