diff --git a/Basic/IO-Misc/t/misc.t b/Basic/IO-Misc/t/misc.t index cb45224be..2656fe9c7 100644 --- a/Basic/IO-Misc/t/misc.t +++ b/Basic/IO-Misc/t/misc.t @@ -4,13 +4,7 @@ use PDL::LiteF; use PDL::IO::Misc; use File::Temp qw( tempfile tempdir ); use Test::More; - -sub tapprox { - my($x,$y) = @_; - my $c = abs($x-$y); - my $d = max($c); - $d < 0.0001; -} +use Test::PDL; my $tempd = tempdir( CLEANUP => 1 ) or die "Couldn't get tempdir\n"; my ($fileh,$file) = tempfile( DIR => $tempd ); @@ -154,38 +148,36 @@ EOD close($fileh); ($x,$y) = rcols $file,0,1; -is( $x->nelem==4 && sum($x)==6 && sum($y)==20, 1, - "rcols: default" ); +is_pdl $x, pdl(1,3,-5,7), "rcols: default"; +is_pdl $y, pdl(2,4,6,8), "rcols: default"; ($x,$y) = rcols \*DATA,0,1; -is( $x->nelem==4 && sum($x)==6 && sum($y)==20, 1, - "rcols: pipe" ); +is_pdl $x, pdl(1,3,-5,7), "rcols: fh"; +is_pdl $y, pdl(2,4,6,8), "rcols: fh"; ($x,$y) = rcols $file,0,1, { INCLUDE => '/^-/' }; -is( $x->nelem==1 && $x->at(0)==-5 && $y->at(0)==6, 1, - "rcols: include pattern" ); +is_pdl $x, pdl([-5]), "rcols: include pattern"; +is_pdl $y, pdl([6]), "rcols: include pattern"; ($x,$y) = rcols $file,0,1, { LINES => '-2:0' }; -is( $x->nelem==3 && tapprox($x,pdl(-5,3,1)) && tapprox($y,pdl(6,4,2)), 1, - "rcols: lines option" ); +is_pdl $x, pdl(-5,3,1), "rcols: lines option"; +is_pdl $y, pdl(6,4,2), "rcols: lines option"; use PDL::Types; ($x,$y) = rcols $file, { DEFTYPE => long }; -is( $x->nelem==4 && $x->get_datatype==$PDL_L && $y->get_datatype==$PDL_L, 1, - "rcols: deftype option" ); +is_pdl $x, long(1,3,-5,7), "rcols: deftype option"; +is_pdl $y, long(2,4,6,8), "rcols: deftype option"; ($x,$y) = rcols $file, { TYPES => [ ushort ] }; -is( $x->nelem==4 && $x->get_datatype==$PDL_US && $y->get_datatype==$PDL_D, 1, - "rcols: types option" ); +is_pdl $x, ushort(1,3,-5,7), "rcols: types option"; +is_pdl $y, double(2,4,6,8), "rcols: types option"; -is( UNIVERSAL::isa($PDL::IO::Misc::deftype,"PDL::Type"), 1, - "PDL::IO::Misc::deftype is a PDL::Type object" ); -is( $PDL::IO::Misc::deftype->[0], double->[0], - "PDL::IO::Misc::deftype check" ); +isa_ok $PDL::IO::Misc::deftype, "PDL::Type", "PDL::IO::Misc::deftype"; +is $PDL::IO::Misc::deftype, 'double', "PDL::IO::Misc::deftype check"; $PDL::IO::Misc::deftype = short; ($x,$y) = rcols $file; -is( $x->get_datatype, short->[0], "rcols: can read in as 'short'" ); +is( $x->get_datatype, short->enum, "rcols: can read in as 'short'" ); unlink $file || warn "Could not unlink $file: $!"; diff --git a/Basic/IO-Pnm/t/pnm.t b/Basic/IO-Pnm/t/pnm.t index 05fde73dd..7b03d1953 100644 --- a/Basic/IO-Pnm/t/pnm.t +++ b/Basic/IO-Pnm/t/pnm.t @@ -7,13 +7,7 @@ use PDL::Dbg; use File::Temp qw(tempdir); use File::Spec; use Test::More; - -# we need tests with index shuffling once vaffines are fixed - -sub tapprox { - my($pa,$pb,$mdiff) = @_; - all approx($pa, $pb,$mdiff || 0.01); -} +use Test::PDL; my $tmpdir = tempdir( CLEANUP => 1 ); sub rpnm_unlink { @@ -63,18 +57,16 @@ for my $raw (0,1) { foreach my $form (@formats) { my $in = rpnm_unlink($im2, $form->[1], 'PGM', $raw); my $comp = ($form->[3] ? $im2->dummy(0,3) : $im2); - ok(tapprox($in,$comp)) or diag "got=$in\nexpected=$comp"; + is_pdl $in,$comp; $comp = $form->[3] ? ($im3->dummy(0,3)>0)*255 : ($im3 > 0); $comp = $comp->ushort*65535 if $form->[0] eq 'SGI'; # yet another format quirk $in = rpnm_unlink($im3, $form->[1], 'PBM', $raw); - ok(tapprox($in,$comp)) or diag "got=$in\nexpected=$comp"; + is_pdl $in,$comp; next if $form->[0] eq 'GIF'; $in = rpnm_unlink($im1, $form->[1], 'PGM', $raw); my $scale = $form->[3] ? $im1->dummy(0,3) : $im1; $comp = $scale / $form->[2]; - ok(tapprox($in,$comp,$form->[4]), $form->[0]) - or diag "got=$in\nexpected=$comp", $in->info; - note $in->px if $PDL::debug and $form->[0] ne 'TIFF'; + is_pdl $in, $comp, {atol=>$form->[4], test_name=>$form->[0]}; } } diff --git a/Basic/Lib-ImageRGB/t/picnorgb.t b/Basic/Lib-ImageRGB/t/picnorgb.t index b7817f647..bacd86ea5 100644 --- a/Basic/Lib-ImageRGB/t/picnorgb.t +++ b/Basic/Lib-ImageRGB/t/picnorgb.t @@ -8,7 +8,6 @@ use File::Spec; use strict; use warnings; -# we need tests with index shuffling once vaffines are fixed use Test::More; sub tapprox { diff --git a/Basic/Lib-ImageRGB/t/picrgb.t b/Basic/Lib-ImageRGB/t/picrgb.t index 596f55d2a..847b7d908 100644 --- a/Basic/Lib-ImageRGB/t/picrgb.t +++ b/Basic/Lib-ImageRGB/t/picrgb.t @@ -8,8 +8,6 @@ use PDL::Dbg; use File::Temp qw(tempdir); use File::Spec; -# we need tests with index shuffling once vaffines are fixed - sub tapprox { my($pa,$pb,$mdiff) = @_; all approx($pa, $pb,$mdiff || 0.01);