zap remaining misuse of all,== from tests - #34

Author: mohawk2

t/fft.t

@@ -10,9 +10,9 @@ foreach my $type(double,float,cdouble,cfloat){
   my $pa = pdl($type,1,-1,1,-1);
   my $pb = zeroes($type,$pa->dims);
   fft($pa,$pb);
-  ok(all($pa==pdl($type,0,0,4,0)), "fft for type $type");
+  is_pdl $pa, pdl($type,0,0,4,0), "fft for type $type";
   ifft($pa,$pb);
-  ok(all($pa==pdl($type,1,-1,1,-1)), "ifft for type $type");
+  is_pdl $pa, pdl($type,1,-1,1,-1), "ifft for type $type";
 }
 
 my $pa = rfits("lib/PDL/Demos/m51.fits");

t/fits.t

@@ -29,10 +29,10 @@ wfits($t, $file);
 $t2 = rfits $file;
 is_pdl $t2, $t, 'w/rfits round-trip';
 my $h = $t2->gethdr;
-ok( $$h{FOO} eq "foo" && $$h{BAR} == 42,
-    "header check on FOO/BAR" );
-ok( $$h{'NUM'}+1 == 124 && $$h{'NUMSTR'} eq '0123',
-    "header check on NUM/NUMSTR" );
+is $$h{FOO}, "foo", "header check on FOO";
+is $$h{BAR}, 42, "header check on BAR";
+is $$h{'NUM'}+1, 124, "header check on NUM";
+is $$h{'NUMSTR'}, '0123', "header check on NUMSTR";
 unlink $file;
 
 SKIP: {
@@ -227,7 +227,7 @@ SKIP:{
     unlink $file;
     wfits($ar,$file);
     my $y = rfits($file);
-    ok(all($ar==$y),"fftnd output (non-contiguous in memory) is written correctly");
+    is_pdl $ar, $y, "fftnd output (non-contiguous in memory) is written correctly";
     unlink $file;
 }
 
@@ -243,11 +243,8 @@ lives_ok { wfits([$x,$y],$file) } "wfits with multiple HDUs didn't fail";
 
 lives_ok { @aa = rfits($file) } "rfits in list context didn't fail";
 
-ok( $aa[0]->ndims == $x->ndims && all($aa[0]->shape == $x->shape), "first element has right shape");
-ok( all($aa[0] == $x), "first element reproduces written one");
-
-ok( $aa[1]->ndims == $y->ndims && all($aa[1]->shape == $y->shape), "second element has right shape");
-ok( all($aa[1] == $y), "Second element reproduces written one");
+is_pdl $aa[0], $x, "first element reproduces written one";
+is_pdl $aa[1], $y, "Second element reproduces written one";
 
 unlink $file;
 
@@ -263,9 +260,9 @@ SKIP:{
 	is $@, '', "writing a longlong image succeeded";
 	eval { $y = rfits($file); };
 	is $@, '', "Reading the longlong image succeeded";
-	ok(ref($y->hdr) eq "HASH", "Reading the longlong image produced a PDL with a hash header");
-	ok($y->hdr->{BITPIX} == 64, "BITPIX value was correct");
-	ok(all($y==$x),"The new image matches the old one (longlong)");
+	isa_ok $y->hdr, "HASH", "Reading the longlong image produced a PDL with a hash header";
+	is $y->hdr->{BITPIX}, 64, "BITPIX value was correct";
+	is_pdl $y, $x, "The new image matches the old one (longlong)";
 	unlink $file;
 }
 

t/flexraw-iotypes.t

@@ -5,6 +5,7 @@ use PDL::Types ':All';
 use PDL::IO::FlexRaw;
 use File::Temp;
 use Test::More;
+use Test::PDL;
 
 our @types = grep $_ != indx(), types();
 
@@ -17,7 +18,7 @@ for my $type (@types) {
   writeflexhdr($data,$hdr);
   my $npdl = eval {readflex $data};
   is $pdl->type, $npdl->type;
-  ok all $pdl == $npdl;
+  is_pdl $pdl, $npdl;
 }
 
 unlink $data, "${data}.hdr";

t/inlinepdlpp.t

@@ -1,6 +1,7 @@
 use strict;
 use warnings;
 use Test::More;
+use Test::PDL;
 
 BEGIN {
   my $inline_test_dir = './.inlinepdlpp';
@@ -33,7 +34,7 @@ is $@, '', 'bind no error';
 my $x = sequence(3,3);
 my $y = $x->testinc;
 is myshape($x), myshape($y), 'myshape eq';
-ok(all $y == $x+1, '==');
+is_pdl $y, $x+1;
 
 sub myshape { join ',', $_[0]->dims }
 

t/io-pnm.t

@@ -21,7 +21,7 @@ sub rpnm_unlink {
   close $fh;
   open $fh, '<', $file;
   my $pdl2 = rpnm($fh);
-  ok all($pdl == $pdl2), 'rpnm from fh same as from disk file';
+  is_pdl $pdl, $pdl2, 'rpnm from fh same as from disk file';
   unlink $file;
   return $pdl;
 }

t/niceslice.t

@@ -1,6 +1,7 @@
 use strict;
 use warnings;
 use Test::More;
+use Test::PDL;
 use PDL::LiteF;
 #BEGIN { $PDL::NiceSlice::debug = $PDL::NiceSlice::debug_filter = 1 }
 require PDL::NiceSlice;
@@ -42,44 +43,42 @@ $pb = translate_and_run '$pa->((5));';
 cmp_ok($pb->at, '==', 5);
 
 $pb = translate_and_run '$pa(($c(1)->at(0)));';
-is $pb->getndims, 0;
-ok(all $pb == 6);
+is_pdl $pb, pdl(6);
 
 # the latest versions should do the 'at' automatically
 $pb = translate_and_run '$pa(($c(1)));';
-is $pb->getndims, 0;
-ok(all $pb == 6);
+is_pdl $pb, pdl(6);
 
 $c = translate_and_run '$pa(:);';
-ok ($c->getdim(0) == 10 && all $c == $pa);
+is_pdl $c, $pa;
 
 $pb = translate_and_run '$pa($idx);';
-ok(all $pb == $idx);
+is_pdl $pb, $idx;
 
 # use 1-el ndarrays as indices
 my $cmp = pdl(2,4,6);
 $pb = translate_and_run '$pa($rg(0):$rg(1):$rg(2));';
-ok(all $pb == $cmp);
+is_pdl $pb, $cmp;
 
 # mix ranges and index ndarrays
 $pa = sequence 5,5;
 $idx = pdl 2,3,0;
 $cmp = $pa->slice('-1:0')->dice_axis(1,$idx);
 translate_and_run '$pb = $pa(-1:0,$idx);';
-ok(all $pb == $cmp);
+is_pdl $pb, $cmp;
 
 #
 # modifiers
 #
 
 $pa = sequence 10;
 $pb = translate_and_run '$pa($pa<3;?)' ;
-ok(all $pb == pdl(0,1,2));
+is_pdl $pb, pdl(0,1,2);
 
 # flat modifier
 $pa = sequence 3,3;
 $pb = translate_and_run '$pa(0:-2;_);';
-ok(all $pb == sequence 8);
+is_pdl $pb, sequence 8;
 
 # where modifier cannot be mixed with other modifiers
 $pa = sequence 10;
@@ -89,28 +88,28 @@ $pb = translate_and_run '$pa($pa<3;?_)', qr/more than 1/;
 $pa = sequence 3,3;
 $pb = translate_and_run '$pa(0;-|)';
 eval {$pb++};
-ok($pb->dim(0) == 3 && all $pb == 3*sequence(3)+1) or diag $pb;
+is_pdl $pb, 3*sequence(3)+1;
 ok($pa->at(0,0) == 0) or diag $pa;
 
-# do we ignore whitspace correctly?
+# do we ignore whitespace correctly?
 $c = translate_and_run '$pa(0; - | )';
-ok (all $c == $pb-1);
+is_pdl $c, $pb-1;
 
 # empty modifier block
 $pa = sequence 10;
 $pb = translate_and_run '$pa(0;   )';
-ok ($pb == $pa->at(0));
+is $pb, $pa->at(0);
 
 # modifiers repeated
 $pb = translate_and_run '$pa(0;-||)', qr/twice or more/;
 
 $pa = sequence(3);
 translate_and_run 'my $x = 1 / 2; $pa = $pa((2)); $x =~ /\./;';
-is $pa.'', '2', '/ not treated as starting a regex';
+is_pdl $pa, pdl(2), '/ not treated as starting a regex';
 
 $pa = sequence(3);
 translate_and_run 'my $x = (0.5 + 0.5) / 2; $pa = $pa((2)); $x =~ /\./;';
-is $pa.'', '2', '/ not treated as starting a regex even after paren';
+is_pdl $pa, pdl(2), '/ not treated as starting a regex even after paren';
 
 # foreach/for blocking
 

t/pic-rim.t

@@ -3,6 +3,7 @@ use warnings;
 use PDL::LiteF;
 use PDL::IO::Pic;
 use Test::More;
+use Test::PDL;
 use File::Temp qw(tempdir);
 use File::Spec;
 
@@ -24,11 +25,7 @@ sub test_pdl {
   rim($out2, $file, {FORMAT => $fmt});
   my $out3 = PDL->rpic($file, {FORMAT => $fmt});
   if ($expect_reorder) { $_ = $_->mv(-1,0) for $out1, $out2 }
-  eval {ok all($out1 == $in), "\$out1 & \$in are the same $orig_info"};
-  is $@, '', $orig_info;
-  eval {ok all($out2 == $in), "\$out2 & \$in are the same $orig_info"};
-  is $@, '', $orig_info;
-  eval {ok all($out3 == $in), "\$out3 & \$in are the same $orig_info"}
-    or diag "in=$in\nout1=$out1";
-  is $@, '', $orig_info;
+  is_pdl $out1, $in, "\$out1 & \$in are the same $orig_info";
+  is_pdl $out2, $in, "\$out2 & \$in are the same $orig_info";
+  is_pdl $out3, $in, "\$out3 & \$in are the same $orig_info";
 }

t/pic_16bit.t

@@ -1,6 +1,7 @@
 use strict;
 use warnings;
 use Test::More;
+use Test::PDL;
 use File::Temp qw(tempdir);
 use File::Spec;
 use PDL::LiteF;
@@ -20,8 +21,7 @@ sub roundtrip {
   $in->wpic($file);
   my $got = rpic($file, @extra);
   return is_deeply [$got->dims], [$in->dims] if $dimonly;
-  eval {ok all($in == $got), "$label image save+restore"};
-  is $@, '', "$label compare worked";
+  is_pdl $got, $in, {require_equal_types=>0, test_name=>"$label image save+restore"};
 }
 
 # test save/restore of 8-bit image

t/ppt-02_non_threaded.t

@@ -3,7 +3,8 @@ use strict;
 use warnings;
 
 # Test declaration
-use Test::More tests => 9;
+use Test::More;
+use Test::PDL -atol => 0;
 
 # Modules needed for actual testing
 use PDL::LiteF;
@@ -18,23 +19,11 @@ use PDL::Parallel::threads qw(retrieve_pdls);
 # something nontrivial across all its bits.
 my $data = (sequence(10)+1)->sqrt->share_as('Test::Set1');
 my $to_compare = $data;
-ok(all($to_compare == $data), 'A ndarray exactly equals itself')
-	or diag("Original is $data and comparison is $to_compare;\n"
-		. "original - comparison = " . ($data - $to_compare));
+is_pdl $to_compare, $data, 'A ndarray exactly equals itself';
 
 # Now retrieve the value from the "off-site" storage
 $to_compare = retrieve_pdls('Test::Set1');
-is_deeply([$to_compare->dims], [$data->dims], 'Retrieved dims is correct')
-	or diag("Original dims are " . join(', ', $data->dims)
-		. " and retrieved dims are " . join', ', $to_compare->dims);
-
-ok($data->type == $to_compare->type, 'Retrieved type is correct')
-	or diag("Original type is " . $data->type
-		. " and retrieved type is " . $to_compare->type);
-
-ok(all($to_compare == $data), 'Retrieved value exactly equals original')
-	or diag("Original is $data and retrieved is $to_compare;\n"
-		. "original - retrieved = " . ($data - $to_compare));
+is_pdl $to_compare, $data, 'Retrieved value exactly equals original';
 
 ###########################
 # Shared modifications: 2 #
@@ -43,14 +32,10 @@ ok(all($to_compare == $data), 'Retrieved value exactly equals original')
 use PDL::NiceSlice;
 # Modify the original, see if it is reflected in the retrieved copy
 $data(3) .= -10;
-ok(all($to_compare == $data), 'Modification to original is reflected in retrieved')
-	or diag("Original is $data and retrieved is $to_compare;\n"
-		. "original - retrieved = " . ($data - $to_compare));
+is_pdl $to_compare, $data, 'Modification to original is reflected in retrieved';
 
 $to_compare(8) .= -50;
-ok(all($to_compare == $data), 'Modification to retrieved is reflected in original')
-	or diag("Original is $data and retrieved is $to_compare;\n"
-		. "original - retrieved = " . ($data - $to_compare));
+is_pdl $to_compare, $data, 'Modification to retrieved is reflected in original';
 
 ###############################
 # Undefine doesn't destroy: 3 #
@@ -60,12 +45,13 @@ my $expected = pdl(1, -10, -50);  # These need to line up with the
 my $idx = pdl(0, 3, 8);           # indices and values used/set above
 
 undef($to_compare);
-ok(all($data($idx) == $expected), "Undeffing copy doesn't destroy data");
+is_pdl $data($idx), $expected, "Undeffing copy doesn't destroy data";
 
 undef($data);
 my $new = retrieve_pdls('Test::Set1');
-ok(all($new($idx) == $expected), "Can retrieve data even after undefing original");
+is_pdl $new($idx), $expected, "Can retrieve data even after undefing original";
 
 PDL::Parallel::threads::free_pdls('Test::Set1');
-ok(all($new($idx) == $expected), "Reference counting works");
+is_pdl $new($idx), $expected, "Reference counting works";
 
+done_testing;

t/ppt-03_name_munging.t

@@ -7,14 +7,15 @@ use PDL::LiteF;
 use PDL::Parallel::threads qw(retrieve_pdls);
 use Test::More;
 use Test::Exception;
+use Test::PDL;
 
 sequence(20)->sqrt->share_as('test');
 my $short_name = retrieve_pdls('test');
 my $long_name;
 lives_ok { $long_name = retrieve_pdls('My::Foo/test') } 'Retrieving fully '
 	. 'resolved name does not croak (that is, they exist)';
-ok(all($short_name == $long_name), 'Regular names get auto-munged with the '
-		. 'current package name');
+is_pdl $short_name, $long_name, 'Regular names get auto-munged with the '
+		. 'current package name';
 
 sequence(20)->share_as('??foo');
 lives_ok { retrieve_pdls('??foo') } 'Basic retrieval with funny name works';