Test cleanup 3

TODO

@@ -37,32 +37,14 @@ the work planned for the future  PDL-2.x releases.
 |                       TESTING                         |
 +-------------------------------------------------------+
 
-
-   Refactor to use Test::More
-   * limits_normalize_dsets.t
-   * segfault.t
-
-   Convert from Test to Test::More
-   * bess.t
-   * conv.t
-   * diskcache.t
-   * erf.t
-   * erfi.t
-   * fft.t
-   * func.t
-   * hist.t
-   * image2d.t
-   * lut.t
-   * lvalue.t
-   * matrix.t
-   * matrixops.t
-   * niceslice.t
-   * nsdatahandle.t
-   * requiredmods.t
-   * round.t
-   * simplex.t
-   * trig.t
-   * xvals.t
+   Need to test PDL build from scratch both WITH_BADVAL and without
+   * Find a way to automate this process for release testing
+   * Unix/Linux/BSD
+   * Windows
+     - cygwin
+     - activestate perl
+     - strawberry perl
+   * Mac OS X
 
 
    Verify dependency detection across all major PDL platforms

t/bess.t

@@ -2,29 +2,36 @@
 
 use Test::More tests => 6;
 
+use strict;
+use warnings;
+
 use PDL::LiteF;
 use PDL::Math;
 
-kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
 sub tapprox {
-        my($a,$b) = @_;
-        $c = abs($a-$b);
-        $d = max($c);
-        $d < 0.01;
+        my($pa,$pb) = @_;
+	all approx $pa, $pb, 0.01;
 }
 
 ok( tapprox(bessj0(0.5),0.9384) && tapprox(bessj0(0),1) ,"bessj0");
 ok( tapprox(bessj1(0.1),0.0499) && tapprox(bessj1(0),0) ,"bessj1");
 ok( tapprox(bessjn(0.8,3),0.010) && tapprox(bessyn(0.2,2),-32.15714) ,"bessjn");
 
+{
 # test inplace
-$a = pdl(0.5,0.0);
-$a->inplace->bessj0;
-ok( tapprox($a,pdl(0.9384,1)), "bessj0 inplace" );
+my $pa = pdl(0.5,0.0);
+$pa->inplace->bessj0;
+ok( tapprox($pa,pdl(0.9384,1)), "bessj0 inplace" );
+}
 
-$a = pdl(0.2);
-$a->inplace->bessyn(2);
-ok( tapprox( $a, -32.15714 ) , "bessyn inplace");
+{
+my $pa = pdl(0.2);
+$pa->inplace->bessyn(2);
+ok( tapprox( $pa, -32.15714 ), "bessyn inplace" );
+}
 
-ok( tapprox( pow(2,3),8), "pow");
+{
+ok( tapprox( pow(2,3),8), "pow"); # test for the pow bug
+}

t/bool.t

@@ -1,4 +1,4 @@
-use Test::More tests => 6;
+use Test::More tests => 5;
 use Test::Exception;
 use PDL::LiteF;
 use strict;
@@ -14,18 +14,17 @@ kill 'INT',$$  if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
 {
 	my $pa = ones 3;
-	throws_ok { print "oops\n" if $pa } qr/multielement/;
+	throws_ok { print "oops\n" if $pa } qr/multielement/, 'multielement piddle in conditional expression';
+	ok all $pa, 'all elements true';
 }
 
-$a = ones 3;
-eval {print "oops\n" if $a};
-like $@, qr/multielement/, 'multielement piddle in conditional expression';
-
-ok all($a),'all elements true';
-
-$a = pdl byte, [ 0, 0, 1 ];
-ok any($a > 0),'any element true';
+{
+	my $pa = pdl byte, [ 0, 0, 1 ];
+	ok any($pa > 0), 'any element true';
+}
 
-$a = ones 3;
-$b = $a + 1e-4;
-ok all(PDL::approx $a, $b, 1e-3), 'approx';
+{
+	my $pa = ones 3;
+	my $pb = $pa + 1e-4;
+	ok all(PDL::approx($pa, $pb, 1e-3)), 'approx';
+}

t/callext.t

@@ -19,10 +19,8 @@ use File::Spec;
 kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
 sub tapprox {
-        my($a,$b) = @_;
-        my $c = abs($a-$b);
-        my $d = max($c);
-        $d < 0.01;
+	my($pa,$pb) = @_;
+	all approx($pa, $pb, 0.01);
 }
 
 # Create the filenames
@@ -56,26 +54,26 @@ done_testing;
 
 sub loglog {
 
-   die 'Usage: loglog($x,$y)' if scalar(@_)!=2;
+	die 'Usage: loglog($x,$y)' if scalar(@_)!=2;
 
-   # Tips:
-   #
-   # (i)  topdl() forces arguments to be pdl vars even
-   #      if ordinary numbers are passed
-   #
-   # (ii) float() forces the pdl vars to be float precision
-   #      thus matching the C routine.
+	# Tips:
+	#
+	# (i)  topdl() forces arguments to be pdl vars even
+	#      if ordinary numbers are passed
+	#
+	# (ii) float() forces the pdl vars to be float precision
+	#      thus matching the C routine.
 
-   my $x = float(topdl(shift));
-   my $y = float(topdl(shift));
+	my $x = float(topdl(shift));
+	my $y = float(topdl(shift));
 
-   my $ret = $x->copy; # Make copy of $x to return
+	my $ret = $x->copy; # Make copy of $x to return
 
-   print "X = $x\n";
-   print "Y = $y\n";
+	note "X = $x\n";
+	note "Y = $y\n";
 
-   my $ldfile =
-   callext($out, "loglog_ext", $ret, $y);
+	my $ldfile =
+	callext($out, "loglog_ext", $ret, $y);
 
-   return $ret;
+	return $ret;
 }

t/clump.t

@@ -12,12 +12,12 @@ $|=1;
 #  PDL::Core::set_debugging(1);
 kill 'INT',$$  if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
-#$a = zeroes(4,4) * zeroes(4,4);
-# $a = zeroes(4,4) ;
+#$pa = zeroes(4,4) * zeroes(4,4);
+# $pa = zeroes(4,4) ;
 
-#print $a;
+#print $pa;
 #
-#print $a->at(3,3);
+#print $pa->at(3,3);
 #
 #exit 4;
 
@@ -60,9 +60,9 @@ if(0) {
 	my $pa = xvals(zeroes(3,3)) + 10*yvals(zeroes(3,3));
 	note $pa;
 	my $pb = $pa->clump(-1);
-	# $b->make_physical();
-	# $a->jdump();
-	# $b->jdump();
+	# $pb->make_physical();
+	# $pa->jdump();
+	# $pb->jdump();
 
 	note $pb;
 

t/conv.t

@@ -5,36 +5,40 @@
 
 use Test::More tests => 7;
 
+use strict;
+use warnings;
+
 use PDL::LiteF;
 use PDL::Types;
 use PDL::Constants qw(PI);
 use strict;
 use warnings;
 
-my $A = pdl 42.4;
-note "A is $A\n";
+my $pa = pdl 42.4;
+note "A is $pa";
 
-is($A->get_datatype,$PDL_D, "A is double");
+is($pa->get_datatype,$PDL_D, "A is double");
 
-my $B = byte $A;
-note "B (byte $A) is $B\n";
+my $pb = byte $pa;
+note "B (byte $pa) is $pb";
 
-is($B->get_datatype,$PDL_B, "B is byte");
-is($B->at(),42, 'byte value is 42');
+is($pb->get_datatype,$PDL_B, "B is byte");
+is($pb->at(),42, 'byte value is 42');
 
-my $C = $B * 3;
-is($C->get_datatype, $PDL_B, "C also byte");
-note "C ($B * 3) is $C\n";
+my $pc = $pb * 3;
+is($pc->get_datatype, $PDL_B, "C also byte");
+note "C ($pb * 3) is $pc";
 
-my $D = $B * 600.0;
-is($D->get_datatype, $PDL_F, "D promoted to float");
-note "D ($B * 600) is $D\n";
+my $pd = $pb * 600.0;
+is($pd->get_datatype, $PDL_F, "D promoted to float");
+note "D ($pb * 600) is $pd";
 
-my $E = $B * PI;
-is($E->get_datatype, $PDL_D, "E promoted to double");
-note "E ($B * PI) is $E\n";
+my $pi = 4*atan2(1,1);
 
-my $F = $B * "-2.2";
-is($F->get_datatype, $PDL_D, "F check string handling");
-note "F ($B * string(-2.2)) is $F\n";
+my $pe = $pb * $pi;
+is($pe->get_datatype, $PDL_D, "E promoted to double (needed to represent result)");
+note "E ($pb * PI) is $pe";
 
+my $pf = $pb * "-2.2";
+is($pf->get_datatype, $PDL_D, "F check string handling");
+note "F ($pb * string(-2.2)) is $pf";

t/diskcache.t

@@ -5,35 +5,35 @@ use PDL::Config;
 use File::Temp 'tempdir';
 use File::Spec;
 
+use Test::More tests => 4;
+use Test::Exception;
+
 # Temp directory name.  The catfile() call adds a trailing dir
 # separator (e.g. "/" on POSIX).
 my $d = File::Spec->catfile(tempdir(CLEANUP=>1),"");
 
-use Test::More tests => 4;
+##1 Make sure the library loads
 
-eval 'use PDL::DiskCache;';
-ok( !$@, "use PDL::DiskCache succeeds" ) or diag($@);
+use PDL::DiskCache;
 
 ## Make a DiskCache object
 ##exercises STORE, sync, and DESTROY
 
-eval <<'BAR'
-  do {
-    my($a) = diskcache(["${d}1","${d}2","${d}3"],{verbose=>1});
-    $a->[0] = zeroes(10,10);
-    $a->[1] = xvals(10,10);
-    $a->[2] = yvals(10,10);
-  } while(0);
-BAR
-  ;
-ok( !$@, "Make a DiskCache object") or diag($@);
+lives_ok {
+  my($pa) = diskcache(["${d}1","${d}2","${d}3"],{verbose=>1});
+  $pa->[0] = zeroes(10,10);
+  $pa->[1] = xvals(10,10);
+  $pa->[2] = yvals(10,10);
+  1;
+} "Make a DiskCache object";
 
 ok( (-e "${d}1") && (-e "${d}2") && (-e "${d}3"), "3 files written");
 
-eval <<'BAZ'
-  do {
-    my($b) = diskcache(["${d}1","${d}2","${d}3"],{ro=>1});
-    ok( ($b->[0]->sum == 0) && ($b->[1]->sum == xvals(10,10)->sum), "files read correctly");
-  }
-BAZ
-  ;
+my $pb;
+lives_ok {
+  ($pb) = diskcache(["${d}1","${d}2","${d}3"],{ro=>1});
+} 'could read files';
+ok( ($pb->[0]->sum == 0) && ($pb->[1]->sum == xvals(10,10)->sum), 'files read correctly' );
+
+
+# end

t/erf.t

@@ -2,27 +2,29 @@
 use strict;
 use warnings;
 use Test::More tests => 5;
+
 use PDL::LiteF;
 use PDL::Math;
 
 kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
 sub tapprox {
-    my($a,$b) = @_;
-    my $c = abs($a-$b);
-    my $d = max($c);
-    $d < 0.01;
+    my($pa,$pb) = @_;
+    all approx $pa, $pb, 0.01;
 }
 
 ok( tapprox(erf(0.),0.) && tapprox(erf(30.),1.),"erf(0), erf(30)");
 ok( tapprox(erf(0.5),1.-erfc(0.5)), "erf and erfc");
 ok( tapprox(erf(erfi(0.5)),0.5) && tapprox(erfi(erf(0.5)),0.5), "erfi (both ways)");
 
-# now test inplace
-$a = pdl(0.0,30.0);
-$a->inplace->erf;
-ok( tapprox( $a, pdl(0.0,1.0) ), "erf inplace");
+{
+my $pa = pdl(0.0,30.0);
+$pa->inplace->erf;
+ok( tapprox( $pa, pdl(0.0,1.0) ), "erf inplace" );
+}
 
-$a = pdl(0.5);
-$a->inplace->erfc;
-ok( tapprox( 1.0-$a, erf(0.5) ), "erfc inplace");
+{
+my $pa = pdl(0.5);
+$pa->inplace->erfc; 
+ok( tapprox( 1.0-$pa, erf(0.5) ), "erfc inplace" );
+}

t/erfi.t

@@ -7,16 +7,13 @@ use PDL::Math;
 
 kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
-sub tapprox {
-        my($a,$b) = @_;
-        my $c = abs($a-$b);
-        my $d = max($c);
-        $d < 0.01;
-}
+approx(pdl(0), pdl(0), 0.01); # set eps
 
-my $a = pdl( 0.01, 0.0 );
-ok( tapprox( erfi($a), pdl(0.00886,0.0) ), "erfi");
+{
+my $pa = pdl( 0.01, 0.0 );
+ok( all( approx( erfi($pa), pdl(0.00886,0.0) )), "erfi" );
 
 # inplace
-$a->inplace->erfi;
-ok( tapprox( $a, pdl(0.00886,0.0) ), "erfi inplace");
+$pa->inplace->erfi;
+ok( all( approx( $pa, pdl(0.00886,0.0) )), "erfi inplace" );
+}