Rewrite t/ops.t with Test::More

PDLPorters · Mar 13, 2015 · d751ac7 · d751ac7
1 parent b8c25c5
commit d751ac7
Showing 1 changed file with 58 additions and 67 deletions.
diff --git a/t/ops.t b/t/ops.t
@@ -1,22 +1,14 @@
+use Test::More tests => 53;
 use PDL::LiteF;
 kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
-sub ok {
-	my $no = shift ;
-	my $result = shift ;
-	print "not " unless $result ;
-	print "ok $no\n" ;
-}
-
 sub tapprox {
 	my($a,$b,$c,$d) = @_;
 	$c = abs($a-$b);
 	$d = max($c);
 	return $d < 0.01;
 }
 
-print "1..53\n";
-
 # $a0 = zeroes 3,5;
 # $b0 = xvals $a0;
 
@@ -26,19 +18,19 @@ $b = yvals zeroes 3,5;
 
 $c = $a + $b;
 
-ok(1,$c->at(2,2) == 4);
-ok(2,$c->at(2,3) == 5);
+ok($c->at(2,2) == 4);
+ok($c->at(2,3) == 5);
 eval '$c->at(3,3)';
-ok(3,$@ =~ /Position out of range/);
+ok($@ =~ /Position out of range/);
 
 $d = pdl 5,6;
 
 $e = $d - 1;
-ok(4,$e->at(0) == 4);
-ok(5,$e->at(1) == 5);
+ok($e->at(0) == 4);
+ok($e->at(1) == 5);
 $f = 1 - $d;
-ok(6,$f->at(0) == -4);
-ok(7,$f->at(1) == -5);
+ok($f->at(0) == -4);
+ok($f->at(1) == -5);
 
 # Now, test one operator from each group
 # biop1 tested already
@@ -48,99 +40,99 @@ $b = pdl 1.5;
 
 $c = $a > $b;
 
-ok(8,$c->at(1) == 0);
-ok(9,$c->at(2) == 1);
+ok($c->at(1) == 0);
+ok($c->at(2) == 1);
 
 $a = byte pdl 0,1,3;
 $c = $a << 2;
 
-ok(10,$c->at(0) == 0);
-ok(11,$c->at(1) == 4);
-ok(12,$c->at(2) == 12);
+ok($c->at(0) == 0);
+ok($c->at(1) == 4);
+ok($c->at(2) == 12);
 
 
 $a = pdl 16,64,9;
 $b = sqrt($a);
 
-ok(13,tapprox($b,(pdl 4,8,3)));
+ok(tapprox($b,(pdl 4,8,3)));
 
 # See that a is unchanged.
 
-ok(14,$a->at(0) == 16);
+ok($a->at(0) == 16);
 
 $a = pdl 1,0;
 $b = ! $a;
-ok(15,$b->at(0) == 0);
-ok(16,$b->at(1) == 1);
+ok($b->at(0) == 0);
+ok($b->at(1) == 1);
 
 $a = pdl 12,13,14,15,16,17;
 $b = $a % 3;
 
-ok(17,$b->at(0) == 0);
-ok(18,$b->at(1) == 1);
-ok(19,$b->at(3) == 0);
+ok($b->at(0) == 0);
+ok($b->at(1) == 1);
+ok($b->at(3) == 0);
 # [ More modulus testing farther down! ]
 
 # Might as well test this also
 
-ok(20,tapprox((pdl 2,3),(pdl 2,3)));
-ok(21,!tapprox((pdl 2,3),(pdl 2,4)));
+ok(tapprox((pdl 2,3),(pdl 2,3)));
+ok(!tapprox((pdl 2,3),(pdl 2,4)));
 
 # Simple function tests
 
 $a = pdl(2,3);
-ok(22, tapprox(exp($a), pdl(7.3891,20.0855)));
-ok(23, tapprox(sqrt($a), pdl(1.4142, 1.7321)));
+ok(tapprox(exp($a), pdl(7.3891,20.0855)));
+ok(tapprox(sqrt($a), pdl(1.4142, 1.7321)));
 
 # And and Or
 
-ok(24, tapprox(pdl(1,0,1) & pdl(1,1,0), pdl(1,0,0)));
-ok(25, tapprox(pdl(1,0,1) | pdl(1,1,0), pdl(1,1,1)));
+ok(tapprox(pdl(1,0,1) & pdl(1,1,0), pdl(1,0,0)));
+ok(tapprox(pdl(1,0,1) | pdl(1,1,0), pdl(1,1,1)));
 
 # atan2
-ok (26, tapprox(atan2(pdl(1,1), pdl(1,1)), ones(2) * atan2(1,1)));
+ok (tapprox(atan2(pdl(1,1), pdl(1,1)), ones(2) * atan2(1,1)));
 
 $a = sequence (3,4);
 $b = sequence (3,4) + 1;
 
-ok (27, tapprox($a->or2($b,0), $a | $b));
-ok (28, tapprox($a->and2($b,0), $a & $b));
-ok (29, tapprox($b->minus($a,0), $b - $a));
-ok (30, tapprox($b - $a, ones(3,4)));
+ok (tapprox($a->or2($b,0), $a | $b));
+ok (tapprox($a->and2($b,0), $a & $b));
+ok (tapprox($b->minus($a,0), $b - $a));
+ok (tapprox($b - $a, ones(3,4)));
 
 # inplace tests
 
 $a = pdl 1;
 $sq2 = sqrt 2; # perl sqrt
 $a->inplace->plus(1,0);  # trailing 0 is ugly swap-flag
-ok(31, tapprox $a, pdl 2);
+ok(tapprox $a, pdl 2);
 $warning_shutup = $warning_shutup = sqrt $a->inplace;
-ok(32, tapprox $a, pdl($sq2));
+ok(tapprox $a, pdl($sq2));
 $a = pdl 4;
-ok(33, tapprox 2, sqrt($a->inplace));
+ok(tapprox 2, sqrt($a->inplace));
 
 # log10 now uses C library
 # check using scalars and piddles
 $a = log10(110);
 $b = log(110) / log(10);
-print "a: $a  [ref(\$a)='", ref($a),"']\n";
-print "b: $b\n";
-ok(34, abs($a-$b) < 1.0e-5 );
+note "a: $a  [ref(\$a)='", ref($a),"']\n";
+note "b: $b\n";
+ok(abs($a-$b) < 1.0e-5 );
 $a = log10(pdl(110,23));
 $b = log(pdl(110,23)) / log(10);
-print "a: $a\n";
-print "b: $b\n";
-ok(35, tapprox $a, $b );
+note "a: $a\n";
+note "b: $b\n";
+ok(tapprox $a, $b );
 
 # check inplace
-ok(36, tapprox pdl(110,23)->inplace->log10(), $b );
+ok(tapprox pdl(110,23)->inplace->log10(), $b );
 $data = ones 5;
 $data &= 0;
-ok(37, all $data == 0);
+ok(all $data == 0);
 $data |= 1;
-ok(38, all $data == 1);
+ok(all $data == 1);
 
-ok(39, all $data eq $data); # check eq operator
+ok(all $data eq $data); # check eq operator
 
 
 #### Modulus checks ####
@@ -150,35 +142,34 @@ ok(39, all $data eq $data); # check eq operator
 $a = pdl(-7..7);
 $b = pdl(-3,0,3)->transpose;
 $c = cat(pdl("-1 0 -2 " x 5),zeroes(15),pdl("2 0 1 " x 5));
-ok(40, all(short($a) % short($b) == short($c)));
-ok(41, all(long($a) % long($b) ==  long($c)));
-ok(42, all(indx($a) % indx($b) == indx($c)));
-ok(43, all(longlong($a) % longlong($b) == longlong($c)));
-ok(44, all(float($a) % float($b) == float($c)));
-ok(45, all(double($a) % double($b) == double($c)));
+ok all(short($a) % short($b) == short($c));
+ok all(long($a) % long($b) ==  long($c));
+ok all(indx($a) % indx($b) == indx($c));
+ok all(longlong($a) % longlong($b) == longlong($c));
+ok all(float($a) % float($b) == float($c));
+ok all(double($a) % double($b) == double($c));
 
 #test unsigned modulus
 # byte/ushort 0/pos % 0/pos
 $a = xvals(15);
 $b = pdl(0,3)->transpose;
 $c = cat(zeroes(15),pdl("0 1 2 " x 5));
-ok(46, all(byte($a) % byte($b)==byte($c)));
-ok(47, all(ushort($a) % ushort($b)==ushort($c)));
+ok all(byte($a) % byte($b)==byte($c));
+ok all(ushort($a) % ushort($b)==ushort($c));
 
 #and for big numbers (bigger than INT_MAX=2147483647)
 #basically this is exercising the (typecast)(X)/(N) in the macros
 $INT_MAX=2147483647;
 
-ok(48,long($INT_MAX)%1 == 0);
-ok(49,indx($INT_MAX*4)%2 == 0);
-ok(50,longlong($INT_MAX*4)%2 == 0);
+ok long($INT_MAX)%1 == 0;
+ok indx($INT_MAX*4)%2 == 0;
+ok longlong($INT_MAX*4)%2 == 0;
 #skip float intentionally here, since float($INT_MAX)!=$INT_MAX
-ok(51,double($INT_MAX*4)%2 == 0);
+ok double($INT_MAX*4)%2 == 0;
 
 #and do the same for byte (unsigned char) and ushort
 $BYTE_MAX = 255;
 $USHORT_MAX = 65535;
 
-ok(52,byte($BYTE_MAX)%1 == 0);
-ok(53,ushort($USHORT_MAX)%1 == 0);
-
+ok byte($BYTE_MAX)%1 == 0;
+ok ushort($USHORT_MAX)%1 == 0;