actually test new-style IO::Storable byte-swap

Basic/IO-Storable/t/storable.t

@@ -1,36 +1,21 @@
 use strict;
 use warnings;
 use Test::More;
+use Test::PDL;
 use Storable qw/freeze thaw retrieve/;
 use PDL::LiteF;
 use PDL::Dbg;
 use PDL::IO::Storable;
 
 my $x = sequence(2,2);
-# $x->dump;
-
 my $serialized = freeze $x;
-
 my $oldx = thaw $serialized;
-# $oldx->dump;
-
-is sum(abs($x-$oldx)), 0, 'PDL freeze/thaw';
+is_pdl $x, $oldx, 'PDL freeze/thaw';
 
-$x = double '1';
+$x = double(1);
 $serialized = freeze $x;
 my $dthaw = thaw $serialized;
-is $dthaw, $x, 'PDL freeze/thaw of PDL scalar';
-
-# $oldb = thaw $serialized;
-# $oldc = thaw $serialized;
-# 
-# $PDL::Dbg::Infostr = "%T %D %S %A";
-# PDL->px;
-# 
-# undef $oldb;
-# print $oldc;
-
-undef $x;
+is_pdl $dthaw, $x, 'PDL freeze/thaw of PDL scalar';
 
 my $data = {
    key1 => 1,
@@ -42,32 +27,29 @@ my $dfreeze = freeze $data;
 $dthaw = thaw $dfreeze;
 
 isa_ok($dthaw, 'HASH'); # we got a HASH back
-
-ok(all($data->{key2} == $dthaw->{key2}), 'PDL in structure');
+is_pdl $dthaw->{key2}, $data->{key2}, 'PDL in structure';
 
 my $phash = bless {PDL => sequence 3}, 'PDL';
 can_ok($phash, 'freeze');
-
 my $pfreeze = $phash->freeze;
 my $phthaw = thaw $pfreeze;
 
-ok(all($phthaw == $phash), 'PDL has-a works with freeze/thaw');
-isa_ok($phthaw,'HASH', 'PDL is a hash');
+is_pdl $phthaw, $phash, 'PDL has-a works with freeze/thaw';
+isa_ok $phthaw, 'HASH', 'PDL is a hash';
 
-# Test that freeze + thaw results in new object
 my $seq1 = sequence(3);
 my $seq1_tf = thaw(freeze($seq1));
 $seq1->slice('1') .= 9;
-ok(! all($seq1 == $seq1_tf), 'Initialization from seraialized object') or
-    diag($seq1, $seq1_tf);
+is_pdl $seq1, pdl(0,9,2);
+is_pdl $seq1_tf, sequence(3), 'mutate orig no change thawed object';
 
 # Test that dclone results in a new object
 # i.e. that dclone(.) == thaw(freeze(.))
 my $seq2 = sequence(4);
 my $seq2_dc = Storable::dclone($seq2);
 $seq2->slice('2') .= 8;
-ok(! all($seq2 == $seq2_dc), 'Initialization from dclone object') or
-    diag($seq2, $seq2_dc);
+is_pdl $seq2, pdl(0,1,8,3);
+is_pdl $seq2_dc, sequence(4), 'mutate orig no change dcloned object';
 
 {
   my @w;
@@ -79,6 +61,20 @@ ok(! all($seq2 == $seq2_dc), 'Initialization from dclone object') or
 # Now test reading from files
 testLoad($_) foreach( qw(t/storable_new_amd64.dat t/storable_old_amd64.dat) );
 
+{
+my $pdl = sequence(5);
+my $native_frozen = freeze $pdl;
+my $f2 = $native_frozen;
+is_pdl thaw($native_frozen), sequence(5), "thawed native";
+my $one = substr($native_frozen, -60, 4); # count from back as Storable uses platform data sizes
+PDL::swapEndian($one, 4);
+my $data = substr($native_frozen, -40, 40);
+PDL::swapEndian($data, 8);
+substr $f2, -60, 4, $one;
+substr $f2, -40, 40, $data;
+is_pdl thaw($f2), sequence(5), "thawed byte-swapped";
+}
+
 done_testing;
 
 # tests loading some files made on different architectures. All these files were
@@ -110,18 +106,9 @@ SKIP:
     }
 
     my $x = retrieve $filename;
-    ok( defined $x, "Reading from file '$filename'" );
-    ok( @$x == 3, "Reading an array-ref of size 3 from file '$filename'" );
-    ok( $x->[1] eq 'abcd', "Reading a correct string from file '$filename'" );
-    isa_ok( $x->[0], 'PDL', "Reading an ndarray from file '$filename'" );
-    isa_ok( $x->[2], 'PDL', "Reading another ndarray from file '$filename'" );
-
-    my $diff0 = $x->[0] - pdl[[0,1,4],
-                              [0,4,10],
-                              [0,7,16]];
-    my $diff2 = $x->[2] - (50 + sequence(7));
-
-    ok( $diff0->max == 0, "Read correct data from file '$filename'" );
-    ok( $diff2->max == 0, "Read more correct data from file '$filename'" );
+    is 0+@$x, 3, "Reading an array-ref of size 3 from file '$filename'";
+    is_pdl $x->[0], pdl[[0,1,4], [0,4,10], [0,7,16]];
+    is $x->[1], 'abcd', "Reading a correct string from file '$filename'";
+    is_pdl $x->[2], 50 + sequence(7);
   }
 }