Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Fix test messages so that they are preserved
  • Loading branch information
zmughal committed Sep 9, 2016
1 parent 483140a commit f46696c
Show file tree
Hide file tree
Showing 7 changed files with 45 additions and 53 deletions.
2 changes: 1 addition & 1 deletion t/conv.t
Expand Up @@ -37,7 +37,7 @@ my $pi = 4*atan2(1,1);

my $pe = $pb * $pi;
is($pe->get_datatype, $PDL_D, "E promoted to double (needed to represent result)");
note "E ($pb * $pi) is $pe";
note "E ($pb * PI) is $pe";

my $pf = $pb * "-2.2";
is($pf->get_datatype, $PDL_D, "F check string handling");
Expand Down
4 changes: 2 additions & 2 deletions t/diskcache.t
Expand Up @@ -32,8 +32,8 @@ ok( (-e "${d}1") && (-e "${d}2") && (-e "${d}3"), "3 files written");
my $pb;
lives_ok {
($pb) = diskcache(["${d}1","${d}2","${d}3"],{ro=>1});
};
ok( ($pb->[0]->sum == 0) && ($pb->[1]->sum == xvals(10,10)->sum) );
} 'could read files';
ok( ($pb->[0]->sum == 0) && ($pb->[1]->sum == xvals(10,10)->sum), 'files read correctly' );


# end
4 changes: 2 additions & 2 deletions t/erfi.t
Expand Up @@ -11,9 +11,9 @@ approx(pdl(0), pdl(0), 0.01); # set eps

{
my $pa = pdl( 0.01, 0.0 );
ok( all approx( erfi($pa), pdl(0.00886,0.0) ), "erfi" );
ok( all( approx( erfi($pa), pdl(0.00886,0.0) )), "erfi" );

# inplace
$pa->inplace->erfi;
ok( all approx( $pa, pdl(0.00886,0.0) ), "erfi inplace" );
ok( all( approx( $pa, pdl(0.00886,0.0) )), "erfi inplace" );
}
36 changes: 18 additions & 18 deletions t/image2d.t
Expand Up @@ -25,15 +25,15 @@ my $ans = pdl(
my $pa = xvals zeroes 10,3;
my $pb = pdl [1,2],[2,1];
my $pc = conv2d ($pa, $pb);
ok all approx( $pc, $ans), "conv2d xvals"; # 1
ok all( approx( $pc, $ans)), "conv2d xvals"; # 1
}

{
# conv2d
my $pa = zeroes(3,3);
$pa->set(1,1,1);
my $pb = sequence(3,3);
ok all approx( conv2d($pa,$pb), $pb ), "conv2d trivial kernel"; # 2
ok all( approx( conv2d($pa,$pb), $pb )), "conv2d trivial kernel"; # 2
}

{
Expand All @@ -42,19 +42,19 @@ my $pa = ones(3,3);
my $pb = sequence(3,3);
{
my $ans = pdl ([12,18,24],[30,36,42],[48,54,60]);
ok all approx( conv2d($pb,$pa,{Boundary => 'Reflect'}), $ans ), "conv2d reflect"; #3
ok all( approx( conv2d($pb,$pa,{Boundary => 'Reflect'}), $ans )), "conv2d reflect"; #3
}

{
# conv2d: boundary => replicate
my $ans = pdl ([12,18,24],[30,36,42],[48,54,60]);
ok all approx( conv2d($pb,$pa,{Boundary => 'Replicate'}), $ans ), "conv2d replicate" ; #4
ok all( approx( conv2d($pb,$pa,{Boundary => 'Replicate'}), $ans )), "conv2d replicate" ; #4
}

{
# conv2d: boundary => truncate
my $ans = pdl ([8,15,12],[21,36,27],[20,33,24]);
ok all approx( conv2d($pb,$pa,{Boundary => 'Truncate'}), $ans ), "conv2d truncate"; #5
ok all( approx( conv2d($pb,$pa,{Boundary => 'Truncate'}), $ans )), "conv2d truncate"; #5
}
}

Expand All @@ -72,8 +72,8 @@ ok( ($ans[0] == 50) & ($ans[1] == 1) & ($ans[2] == 2), "max2d_ind" );
my $pa = 100.0 / rvals( 20, 20, { Centre => [ 8, 12.5 ] } );
$pa = $pa * ( $pa >= 9 );
my @ans = $pa->centroid2d( 10, 10, 20 );
ok all approx( $ans[0], 8.432946), "centroid2d (0)"; # numbers calculated by an independent program
ok all approx( $ans[1], 11.756724), "centroid2d (1)";
ok all( approx( $ans[0], 8.432946)), "centroid2d (0)"; # numbers calculated by an independent program
ok all( approx( $ans[1], 11.756724)), "centroid2d (1)";
}

{
Expand All @@ -83,12 +83,12 @@ my $t = $pa->slice("1:3,1:3");
$t .= ones(3,3);
my $pb = sequence(3,3);
my $ans = pdl ( [0,0,0,0,0],[0,0,1,0,0],[0,1,4,2,0],[0,0,4,0,0],[0,0,0,0,0]);
ok all approx( med2d($pa,$pb), $ans ), "med2d";
ok all( approx( med2d($pa,$pb), $ans )), "med2d";

{
# med2df
my $pa = sequence(10,10);
ok all approx( med2df($pa,3,3,{Boundary=>'Truncate'})->slice("1:-2,1:-2"), $pa->slice("1:-2,1:-2")), "med2df";
ok all( approx( med2df($pa,3,3,{Boundary=>'Truncate'})->slice("1:-2,1:-2"), $pa->slice("1:-2,1:-2"))), "med2df";
}
}

Expand All @@ -97,7 +97,7 @@ ok all approx( med2df($pa,3,3,{Boundary=>'Truncate'})->slice("1:-2,1:-2"), $pa->
my $pa = ones(5,5);
my $mask = zeroes(5,5);
$mask->set(2,2,1);
ok all approx( patch2d($pa,$mask), $pa ), "patch2d 1-element no-op"; # 6
ok all( approx( patch2d($pa,$mask), $pa )), "patch2d 1-element no-op"; # 6

# note:
# with no bad values, any bad pixel which has no good neighbours
Expand All @@ -107,7 +107,7 @@ my $m = $mask->slice('1:3,1:3');
$m .= 1;
my $pans = $pa->copy;
note $pa, $mask, patch2d($pa,$mask);
ok all approx( patch2d($pa,$mask), $pans), "patch2d 2d slice no-op"; # 7
ok all( approx( patch2d($pa,$mask), $pans)), "patch2d 2d slice no-op"; # 7

SKIP: {
skip "PDL::Bad support not available.", 5 unless $PDL::Bad::Status;
Expand All @@ -123,12 +123,12 @@ SKIP: {
$ans->badflag(1);

#note $pa, patchbad2d($pa);
ok all approx( patchbad2d($pa), $ans ), "patchbad2d"; # 8
ok all( approx( patchbad2d($pa), $ans )), "patchbad2d"; # 8

# patchbad2d: good data
$pa = sequence(5,5);
#note $pa, patchbad2d($pa);
ok all approx( patchbad2d($pa), $pa ), "patchbad2d good data"; # 9
ok all( approx( patchbad2d($pa), $pa )), "patchbad2d good data"; # 9

# max2d_ind
$pa = 100 / (1.0 + rvals(5,5));
Expand All @@ -143,8 +143,8 @@ SKIP: {
$pa = 100.0 / rvals( 20, 20, { Centre => [ 8, 12.5 ] } );
$pa = $pa->setbadif( $pa < 9 );
@ans = $pa->centroid2d( 10, 10, 20 );
ok all approx( $ans[0], 8.432946), "centroid2d bad data (0)"; # numbers should be same as when set < 9 to 0
ok all approx( $ans[1], 11.756724), "centroid2d bad data (1)";
ok all( approx( $ans[0], 8.432946)), "centroid2d bad data (0)"; # numbers should be same as when set < 9 to 0
ok all( approx( $ans[1], 11.756724)), "centroid2d bad data (1)";
}

}
Expand All @@ -158,15 +158,15 @@ my $bav = $one->box2d(3,3,0);
my $boxav = $box->box2d(3,3,0);

# all 2D averages should be the same
ok all approx($bav->sum,$boxav->clump(2)->sumover), "box2d";
ok all( approx($bav->sum,$boxav->clump(2)->sumover)), "box2d";
}

{
# cc8compt & cc4compt
{
my $pa = pdl([0,1,1,0,1],[1,0,1,0,0],[0,0,0,1,0],[1,0,0,0,0],[0,1,0,1,1]);
ok(cc8compt($pa)->max == 4);
ok(cc4compt($pa)->max == 7);
is(cc8compt($pa)->max, 4, 'cc8compt');
is(cc4compt($pa)->max, 7, 'cc4compt');
dies_ok { ccNcompt($pa,5); } "ccNcompt(5) fails";
lives_ok { ccNcompt($pa,8) } "ccNcompt(8) succeeds";
}
Expand Down
4 changes: 2 additions & 2 deletions t/lut.t
Expand Up @@ -17,7 +17,7 @@ is( $cols[2]->get_datatype, $PDL_F, "datatype of col 2 is float");

# check we can reverse things
my @cols2 = lut_data( $names[0], 1 );
ok( all approx($cols[3]->slice('-1:0'),$cols2[3]), "reverse lut works");
ok( all( approx($cols[3]->slice('-1:0'),$cols2[3])), "reverse lut works");

# check we know about the intensity ramps
my @ramps = lut_ramps();
Expand All @@ -26,5 +26,5 @@ isnt scalar(@ramps), 0, "lut_ramps returns some ramps";
# load in a different intensity ramp
my @cols3 = lut_data( $names[0], 0, $ramps[0] );
is( $cols3[0]->nelem, $cols3[1]->nelem, "intensity ramp nelem check");
ok( all approx($cols[1],$cols3[1]), "intensity ramp vals check");
ok( all( approx($cols[1],$cols3[1])), "intensity ramp vals check");

14 changes: 3 additions & 11 deletions t/matrixops.t
@@ -1,5 +1,5 @@
use PDL::LiteF;
use Test::More tests => 40;
use Test::More tests => 38;
use Test::Exception;
use Config;

Expand Down Expand Up @@ -184,8 +184,8 @@ ok($esum == 61.308,"eigens sum for 8x8 correct answer");
my $esum=0;
lives_ok {
$esum = sprintf "%.3f", sum scalar eigens_sym($m);
};
ok($esum == 61.308);
} "eigens_sym for 8x8 ran OK";
is($esum, 61.308, 'eigens_sym sum for 8x8 correct answer');
}
{
Expand All @@ -202,14 +202,6 @@ ok($esum == 5);
}
}
{
my $esum = 0;
lives_ok {
$esum = sprintf "%.3f", sum scalar eigens_sym($m);
} "eigens_sym for 8x8 ran OK";
ok($esum == 61.308, "eigens_sym sum for 8x8 correct answer");
}
}
{
Expand Down
34 changes: 17 additions & 17 deletions t/ops.t
Expand Up @@ -63,7 +63,7 @@ ok($pc->at(2) == 12,'3 left bitshift 2 is 12');
my $pa = pdl 16,64,9;
my $pb = sqrt($pa);

ok(all approx($pb,(pdl 4,8,3)),'sqrt of pdl(16,64,9)');
ok(all( approx($pb,(pdl 4,8,3))),'sqrt of pdl(16,64,9)');

# See that a is unchanged.

Expand All @@ -89,37 +89,37 @@ ok($pb->at(3) == 0, 'simple modulus 3');

{
# Might as well test this also
ok(all approx((pdl 2,3),(pdl 2,3)),'approx equality 1');
ok(!all approx((pdl 2,3),(pdl 2,4)),'approx equality 2');
ok(all( approx((pdl 2,3),(pdl 2,3))),'approx equality 1');
ok(!all( approx((pdl 2,3),(pdl 2,4))),'approx equality 2');
}

{
# Simple function tests
my $pa = pdl(2,3);
ok(all approx(exp($pa), pdl(7.3891,20.0855)), 'exponential');
ok(all approx(sqrt($pa), pdl(1.4142, 1.7321)), 'sqrt makes decimal');
ok(all( approx(exp($pa), pdl(7.3891,20.0855))), 'exponential');
ok(all( approx(sqrt($pa), pdl(1.4142, 1.7321))), 'sqrt makes decimal');
}

{
# And and Or

ok(all approx(pdl(1,0,1) & pdl(1,1,0), pdl(1,0,0)), 'elementwise and');
ok(all approx(pdl(1,0,1) | pdl(1,1,0), pdl(1,1,1)), 'elementwise or');
ok(all( approx(pdl(1,0,1) & pdl(1,1,0), pdl(1,0,0))), 'elementwise and');
ok(all( approx(pdl(1,0,1) | pdl(1,1,0), pdl(1,1,1))), 'elementwise or');
}

{
# atan2
ok (all approx(atan2(pdl(1,1), pdl(1,1)), ones(2) * atan2(1,1)), 'atan2');
ok (all( approx(atan2(pdl(1,1), pdl(1,1)), ones(2) * atan2(1,1))), 'atan2');
}

{
my $pa = sequence (3,4);
my $pb = sequence (3,4) + 1;

ok (all approx($pa->or2($pb,0), $pa | $pb), 'or2');
ok (all approx($pa->and2($pb,0), $pa & $pb), 'and2');
ok (all approx($pb->minus($pa,0), $pb - $pa), 'explicit minus call');
ok (all approx($pb - $pa, ones(3,4)), 'pdl subtraction');
ok (all( approx($pa->or2($pb,0), $pa | $pb)), 'or2');
ok (all( approx($pa->and2($pb,0), $pa & $pb)), 'and2');
ok (all( approx($pb->minus($pa,0), $pb - $pa)), 'explicit minus call');
ok (all( approx($pb - $pa, ones(3,4))), 'pdl subtraction');
}

# inplace tests
Expand All @@ -128,12 +128,12 @@ ok (all approx($pb - $pa, ones(3,4)), 'pdl subtraction');
my $pa = pdl 1;
my $sq2 = sqrt 2; # perl sqrt
$pa->inplace->plus(1,0); # trailing 0 is ugly swap-flag
ok(all approx($pa, pdl 2), 'inplace plus');
ok(all( approx($pa, pdl 2)), 'inplace plus');
my $warning_shutup;
$warning_shutup = $warning_shutup = sqrt $pa->inplace;
ok(all approx( $pa, pdl($sq2)), 'inplace pdl sqrt vs perl scalar sqrt');
ok(all( approx( $pa, pdl($sq2))), 'inplace pdl sqrt vs perl scalar sqrt');
my $pb = pdl 4;
ok(all approx( 2, sqrt($pb->inplace)),'perl scalar vs inplace pdl sqrt');
ok(all( approx( 2, sqrt($pb->inplace))),'perl scalar vs inplace pdl sqrt');
}

{
Expand All @@ -152,10 +152,10 @@ my $pa = log10(pdl(110,23));
my $pb = log(pdl(110,23)) / log(10);
note "a: $pa\n";
note "b: $pb\n";
ok(all approx( $pa, $pb), 'log10 pdl');
ok(all( approx( $pa, $pb)), 'log10 pdl');

# check inplace
ok(all approx( pdl(110,23)->inplace->log10(), $pb), 'inplace pdl log10');
ok(all( approx( pdl(110,23)->inplace->log10(), $pb)), 'inplace pdl log10');
}

}
Expand Down

0 comments on commit f46696c

Please sign in to comment.