Merge 4d23291 into 18d5c33

PDLPorters · May 24, 2015 · 8091236 · 8091236
2 parents 18d5c33 + 4d23291
commit 8091236
Show file tree

Hide file tree

Showing 17 changed files with 604 additions and 611 deletions.
diff --git a/t/bool.t b/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;
@@ -15,17 +15,16 @@ kill 'INT',$$  if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 {
 	my $pa = ones 3;
 	throws_ok { print "oops\n" if $pa } qr/multielement/;
+	ok all $pa;
 }
 
-$a = ones 3;
-eval {print "oops\n" if $a};
-like $@, qr/multielement/;
-
-ok all $a;
-
-$a = pdl byte, [ 0, 0, 1 ];
-ok any $a > 0;
+{
+	my $pa = pdl byte, [ 0, 0, 1 ];
+	ok any $pa > 0;
+}
 
-$a = ones 3;
-$b = $a + 1e-4;
-ok all PDL::approx $a, $b, 1e-3;
+{
+	my $pa = ones 3;
+	my $pb = $pa + 1e-4;
+	ok all PDL::approx $pa, $pb, 1e-3;
+}
diff --git a/t/clump.t b/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;
 

diff --git a/t/familyfree.t b/t/familyfree.t
@@ -4,16 +4,19 @@ use strict;
 use warnings;
 
 use Test::More tests => 1;
+use Test::Exception;
 
 kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
 # This is something that would cause an exception on 1.91_00:
 # when the original was undef'd, xchghashes would barf.
 
-my $pa = xvals zeroes(5,5);
-my $pb = $pa->slice(':,2:3');
+lives_ok {
+	my $pa = xvals zeroes(5,5);
+	my $pb = $pa->slice(':,2:3');
 
-$pa = 1;  # Undefine orig. a
-$pb += 1;
+	$pa = 1;  # Undefine orig. a
+	$pb += 1;
+};
 
-ok(1);
+done_testing;
diff --git a/t/gauss.t b/t/gauss.t
@@ -27,19 +27,22 @@ my $g2 = pdl qw[  13.013418  11.397573  7.4494489  4.5594057  2.5728955
 2.2979197  2.2963699  2.1171346  1.8859732  2.1277667  2.0716804  1.9251175];
 
 
-my ($xc, $pk, $fwhm, $back, $err, $fit) = fitgauss1d(xvals($g1), $g1);
+{
+	my ($xc, $pk, $fwhm, $back, $err, $fit) = fitgauss1d(xvals($g1), $g1);
 
+	#points $g1; hold; line $fit; rel;
 
-#points $g1; hold; line $fit; rel;
+	ok( nint($xc)==16 && nint($pk)==11 && nint($fwhm)==4 && nint($back)==2
+	    && nint($err)==0 && sum(abs($g1-$fit))<10);
+}
 
-ok( nint($xc)==16 && nint($pk)==11 && nint($fwhm)==4 && nint($back)==2
-  && nint($err)==0 && sum(abs($g1-$fit))<10);
+{
+	my ($pk, $fwhm, $back, $err, $fit) = fitgauss1dr(xvals($g2),$g2);
 
-($pk, $fwhm, $back, $err, $fit) = fitgauss1dr(xvals($g2),$g2);
+	#points $g2; hold; line $fit; rel;
 
-#points $g2; hold; line $fit; rel;
-
-ok(nint($pk)==11 && nint($fwhm)==4 && nint($back)==2
-  && nint($err)==0 && sum(abs($g2-$fit))<10);
+	ok(nint($pk)==11 && nint($fwhm)==4 && nint($back)==2
+	   && nint($err)==0 && sum(abs($g2-$fit))<10);
+}
 
 done_testing;
diff --git a/t/hdrs.t b/t/hdrs.t
@@ -20,26 +20,36 @@ note "pa: ", Dumper $pa->gethdr();
 
 ok($pa->hdrcpy);
 
-my $pb = $pa+1;
-note "pb: ", Dumper $pb->gethdr();
-ok( defined($pb->gethdr));
-is_deeply($pa->gethdr,$pb->gethdr);
-
-$pb = ones(20) + $pa;
-note "pb: ", Dumper $pb->gethdr();
-ok( defined($pb->gethdr));
-is_deeply($pa->gethdr,$pb->gethdr);
-
-my $pc = $pa->slice('0:5');
-note "pc: ", Dumper $pc->gethdr();
-is_deeply($pa->gethdr,$pc->gethdr);
-
-my $pd = $pa->copy;
-note "pd: ", Dumper $pd->gethdr();
-is_deeply($pa->gethdr,$pd->gethdr);
-
-$pa->hdrcpy(0);
-ok(defined($pa->slice('3')->hdr) && !( keys (%{$pa->slice('3')->hdr})));
-ok(!defined($pa->slice('3')->gethdr));
+{
+	my $pb = $pa+1;
+	note "pb: ", Dumper $pb->gethdr();
+	ok( defined($pb->gethdr));
+	is_deeply($pa->gethdr,$pb->gethdr);
+}
+
+{
+	my $pb = ones(20) + $pa;
+	note "pb: ", Dumper $pb->gethdr();
+	ok( defined($pb->gethdr));
+	is_deeply($pa->gethdr,$pb->gethdr);
+}
+
+{
+	my $pc = $pa->slice('0:5');
+	note "pc: ", Dumper $pc->gethdr();
+	is_deeply($pa->gethdr,$pc->gethdr);
+}
+
+{
+	my $pd = $pa->copy;
+	note "pd: ", Dumper $pd->gethdr();
+	is_deeply($pa->gethdr,$pd->gethdr);
+}
+
+{
+	$pa->hdrcpy(0);
+	ok(defined($pa->slice('3')->hdr) && !( keys (%{$pa->slice('3')->hdr})));
+	ok(!defined($pa->slice('3')->gethdr));
+}
 
 done_testing;
diff --git a/t/imagergb.t b/t/imagergb.t
@@ -1,15 +1,10 @@
 use Test::More tests => 6;
 
-sub tapprox {
-	my($a,$b,$mdiff) = @_;
-	$mdiff = 0.01 unless defined($mdiff);
-	$c = abs($a-$b);
-	$d = max($c);
-	$d < $mdiff;
-}
+use strict;
+use warnings;
 
 sub vars_ipv {
-  PDL::Dbg::vars if $PDL::debug;
+  PDL::Dbg::vars() if $PDL::debug;
 }
 
 sub p {
@@ -22,43 +17,52 @@ use PDL::Dbg;
 
 $PDL::debug = 0;
 
-$im = float [1,2,3,4,5];
 
 vars_ipv;
 
-$out = bytescl($im,100);
-ok(tapprox($im,bytescl($im,100)));
-ok($out->get_datatype == $PDL::Types::PDL_B);
-$out = bytescl($im,-100);
-ok(tapprox(pdl([0,25,50,75,100]),$out));
+{
+	my $im = float [1,2,3,4,5];
+	my $out = bytescl($im,100);
+	ok(all approx($im,$out));
+	ok($out->get_datatype == $PDL::Types::PDL_B);
+}
 
-p "$out\n";
+{
+	my $im = float [1,2,3,4,5];
+	my $out = bytescl($im,-100);
+	ok(all approx(pdl([0,25,50,75,100]),$out));
 
-$rgb = double [[1,1,1],[1,0.5,0.7],[0.1,0.2,0.1]];
-$out = rgbtogr($rgb);
-ok(tapprox($out,pdl([1,0.67,0.16])));
-ok($out->get_datatype == $PDL::Types::PDL_D);
+	p "$out\n";
+}
 
-vars_ipv;
-p $out;
+{
+	my $rgb = double [[1,1,1],[1,0.5,0.7],[0.1,0.2,0.1]];
+	my $out = rgbtogr($rgb);
+	ok(all approx($out,pdl([1,0.67,0.16]), 0.01));
+	ok($out->get_datatype == $PDL::Types::PDL_D);
 
-$im = byte [[1,2,3],[0,3,0]];
-$lut = byte [[0,0,0],
-	     [10,1,10],
-	     [2,20,20],
-	     [30,30,3]
-	    ];
-# do the interlacing the lengthy way
-$interl = zeroes(byte,3,$im->dims);
-for $i (0..($im->dims)[0]-1) {
-  for $j (0..($im->dims)[1]-1) {
-	$pos = $im->at($i,$j);
-	($tmp = $interl->slice(":,($i),($j)")) .= $lut->slice(":,($pos)");
-  }
+	vars_ipv;
+	p $out;
 }
-$tmp = 0; # -w shut up!
 
-$out = interlrgb($im,$lut);
-vars_ipv;
-p $out;
-ok(tapprox($out,$interl));
+{
+	my $im = byte [[1,2,3],[0,3,0]];
+	my $lut = byte [[0,0,0],
+		[10,1,10],
+		[2,20,20],
+		[30,30,3]
+	];
+	# do the interlacing the lengthy way
+	my $interl = zeroes(byte,3,$im->dims);
+	for my $i (0..($im->dims)[0]-1) {
+		for my $j (0..($im->dims)[1]-1) {
+			my $pos = $im->at($i,$j);
+			(my $tmp = $interl->slice(":,($i),($j)")) .= $lut->slice(":,($pos)");
+		}
+	}
+
+	my $out = interlrgb($im,$lut);
+	vars_ipv;
+	p $out;
+	ok(all approx($out,$interl));
+}
diff --git a/t/interp.t b/t/interp.t
@@ -6,6 +6,7 @@ use Test::More skip_all => 'See PDL::Func';
 use PDL::LiteF;
 
 use strict;
+use warnings;
 
 plan tests => 5;
 
@@ -26,8 +27,9 @@ is $obj->status, -1;
 
 # compare to direct version
 my ( $ans, $err ) = PDL::Primitive::interpolate( $xi, $x, $y );
-my $d = abs( $ans - $yi ); 
-ok( all $d < 1.0e-5 );
+ok(all approx($ans, $yi));
+#my $d = abs( $ans - $yi ); 
+#ok( all $d < 1.0e-5 );
 
 my $oerr = $obj->get( 'err' );
 ok( all ($oerr-$err) == 0 );

diff --git a/t/interpol.t b/t/interpol.t
@@ -3,10 +3,13 @@
 use Test::More tests => 1;
 use PDL::Lite;
 
+use strict;
+use warnings;
+
 my $yvalues =  (new PDL( 0..5))   - 20;
 
 my $xvalues = -(new PDL (0..5))*.5;
 
 my $x = new PDL(-2);
 
-ok( $x->interpol($xvalues,$yvalues) == -16 );
+is( $x->interpol($xvalues,$yvalues), -16 );