Skip to content

Commit

Permalink
IO::*Raw tests replace tapprox with is_pdl - #34
Browse files Browse the repository at this point in the history
  • Loading branch information
@mohawk2
mohawk2 committed Oct 29, 2024
1 parent 66b3c5a commit db685da
Show file tree
Hide file tree
Showing 3 changed files with 34 additions and 69 deletions.
23 changes: 9 additions & 14 deletions Basic/IO-FastRaw/t/fastraw.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ use strict;
use warnings;
use Test::More;
use PDL::LiteF;
use Test::PDL;
use File::Temp qw(tempdir);
use File::Spec::Functions;
use PDL::IO::FastRaw;
Expand All @@ -13,11 +14,6 @@ my $name = catfile($tmpdir, "tmp0");
my $name_hdr = "$name.hdr";
my $header = catfile($tmpdir, "headerfile" . $$);

sub tapprox {
my($x,$y) = @_;
my $c = abs($x-$y);
return (max($c) < 0.01);
}
sub startdata { pdl [2,3],[4,5],[6,7] }
sub cleanfiles { unlink for grep -f, $name, $name_hdr, $header }

Expand All @@ -28,7 +24,7 @@ ok((-f $name and -f ($name_hdr)), "Writing should create a file and header file"

# read it back, and make sure it gives the same ndarray
my $y = readfraw($name);
ok(tapprox($x,$y), "A ndarray and its saved copy should be about equal");
is_pdl $x, $y, "A ndarray and its saved copy should be about equal";

# Clean things up a bit
undef $x; undef $y;
Expand All @@ -40,8 +36,7 @@ writefraw($x,"$name.g");
my $x1 = pdl [10,11];
gluefraw($x1,"$name.g");
$y = readfraw("$name.g");
ok(tapprox($y, pdl([2,3],[4,5],[6,7],[10,11])), "glued data correct")
or diag "got:$y";
is_pdl $y, pdl([2,3],[4,5],[6,7],[10,11]), "glued data correct";
unlink "$name.g", "$name.g.hdr";
# Clean things up a bit
undef $x; undef $y;
Expand All @@ -53,7 +48,7 @@ ok -f $header, "writefraw should create the special header file when specified";

# test the use of a custom header for reading
$y = readfraw($name,{Header => $header});
ok tapprox($x,$y), "Should be able to read given a specified header";
is_pdl $x, $y, "Should be able to read given a specified header";

# some mapfraw tests
SKIP:
Expand All @@ -68,13 +63,13 @@ SKIP:
}

# compare mapfraw ndarray with original ndarray
ok(tapprox($x,$c), "A ndarray and its mapfraw representation should be about equal");
is_pdl $x, $c, "A ndarray and its mapfraw representation should be about equal";

# modifications should be saved when $c goes out of scope
$c += 1;
undef $c;
$y = readfraw($name);
ok(tapprox($x+1,$y), "Modifications to mapfraw should be saved to disk no later than when the ndarray ceases to exist");
is_pdl $x+1,$y, "Modifications to mapfraw should be saved to disk no later than when the ndarray ceases to exist";

# We're starting a new test, so we'll remove the files we've created so far
# and clean up the memory, just to be super-safe
Expand All @@ -91,8 +86,8 @@ SKIP:
undef $x; undef $y;
# Load it back up and see if the values are what we expect
$y = readfraw($name);
ok(tapprox($y, PDL->pdl([[0,1,2],[0.1,1.1,2.1]])),
"mapfraw should be able to create new ndarrays");
is_pdl $y, float([[0,1,2],[0.1,1.1,2.1]]),
"mapfraw should be able to create new ndarrays";

# test the created type
ok($y->type == float, 'type should be of the type we specified (float)');
Expand All @@ -115,7 +110,7 @@ SKIP:
}

# test custom headers for mapfraw
ok(tapprox($x,$c), "mapfraw should be able to work with a specified header");
is_pdl $x, $c, "mapfraw works with a specified header";
}

done_testing;
1 change: 0 additions & 1 deletion Basic/IO-FlexRaw/t/flexraw.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ use strict;
use warnings;

use Test::More;
use PDL::LiteF;
use File::Temp qw(tempdir);
use File::Spec::Functions;
use PDL::IO::FlexRaw;
Expand Down
79 changes: 25 additions & 54 deletions Basic/IO-FlexRaw/t/flexraw_fortran.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ use PDL::LiteF;
use PDL::IO::FlexRaw;
use Config;
use Test::More;
use Test::PDL;
use File::Temp qw(tempfile);
use File::Spec;
use File::Which ();
Expand Down Expand Up @@ -43,13 +44,6 @@ if ($ExtUtils::F77::VERSION > 1.03) {
$F77flags = '';
}

sub tapprox {
my ($x,$y) = @_;
my $c = abs($x->flat-$y->flat);
my $d = max($c);
$d < 0.01;
}

sub byte4swap {
my ($file) = @_;
my ($ofile) = $file.'~';
Expand Down Expand Up @@ -268,9 +262,9 @@ EOT

my @a = readflex($data);
# print "@a\n";
my $ok = ($a[0]->at(0) == $ndata);
ok my $ok = ($a[0]->at(0) == $ndata);
my $res = eval "$pdltype $exprp";
ok( $ok && tapprox($res,$a[1]), "readflex $pdltype w hdr file" );
is_pdl $res, $a[1], "readflex $pdltype w hdr file";

open(FILE,">$hdr");
print FILE <<"EOT";
Expand All @@ -289,9 +283,9 @@ EOT

unlink $hdr;

$ok = ($a[0]->at(0) == $ndata);
ok $ok = ($a[0]->at(0) == $ndata);
$res = eval "$pdltype $exprp";
ok( $ok && tapprox($res,$a[1]), "readflex $pdltype w hdr file (explicit swap)" );
is_pdl $res, $a[1], "readflex $pdltype w hdr file (explicit swap)";

# Now try header array
$ok = 1;
Expand All @@ -300,10 +294,9 @@ EOT
{Type => $pdltype, NDims => 1, Dims => [ $ndata ] } ];
@a = readflex($data,$header);
unlink $data;
$ok = ($a[0]->at(0) == $ndata);
ok $ok = ($a[0]->at(0) == $ndata);
$res = eval "$pdltype $exprp";
ok( $ok && tapprox($res,$a[1]), "readflex $pdltype w hdr array" );
# print $a[1]->getndims()," [",$a[1]->dims,"]\n";
is_pdl $res, $a[1], "readflex $pdltype w hdr array";

} # foreach: $pdltype == 'float', 'double'

Expand Down Expand Up @@ -350,9 +343,9 @@ EOT
# print "@a\n";
unlink $data, $hdr;

my $ok = ($a[0]->at(0) == $ndata);
ok my $ok = ($a[0]->at(0) == $ndata);
my $res = eval "$pdltype $exprp";
ok($ok && tapprox($res,$a[1]), "f77 1D $pdltype data");
is_pdl $res, $a[1], "f77 1D $pdltype data";
# print $a[1]->getndims()," [",$a[1]->dims,"]\n";

} # foreach: $pdltype ( keys %types )
Expand Down Expand Up @@ -405,9 +398,9 @@ EOT
# print "@a\n";
unlink $data, $hdr;

my $ok = ($a[1]->at(0) == $ndata);
ok my $ok = ($a[1]->at(0) == $ndata);
my $res = eval "$pdltype $exprp";
ok( $ok && tapprox($res,$a[2]), "no f77, 1D $pdltype data");
is_pdl $res,$a[2], "no f77, 1D $pdltype data";
# print $a[2]->getndims()," [",$a[2]->dims,"]\n";
}

Expand Down Expand Up @@ -458,9 +451,9 @@ EOT
# }
unlink $data, $hdr;

my $ok = ($a[0]->at(0) == $ndata);
ok my $ok = ($a[0]->at(0) == $ndata);
my $res = eval "$pdltype $expr2p";
ok( $ok && tapprox($res,$a[1]), "f77 format 2D $pdltype data");
is_pdl $res, $a[1], "f77 format 2D $pdltype data";
# print $a[1]->getndims()," [",$a[1]->dims,"]\n";
}

Expand Down Expand Up @@ -516,12 +509,10 @@ my $l = long (10**$f);
$i = short ($l);
my $x = byte (32);
my @req = ($x,$i,$l,$f,$d);
my $ok = 1;
foreach (@req) {
my $h = shift @a;
$ok &&= tapprox($_,$h);
is_pdl $h, $_, "readflex combined types";
}
ok( $ok, "readflex combined types" );

SKIP: {
my $compress = File::Which::which('compress') ? 'compress' : 'gzip'; # some linuxes don't have compress
Expand All @@ -532,20 +523,19 @@ SKIP: {
}

# Try compressed data
$ok = 1;
0 == system "$compress -c $data > ${data}.Z" or diag "system $compress -c $data >${data}.Z failed: $?";
unlink( $data );
@a = readflex($data);
$ok &&= $#a==6;
ok $#a==6;
@a = readflex("${data}.Z");
$ok &&= $#a==6;
ok $#a==6;
my $NULL = File::Spec->devnull();
0 == system "gunzip -q ${data}.Z >$NULL 2>&1" or diag "system gunzip -q ${data}.Z failed: $?";
0 == system "gzip -q $data >$NULL 2>&1" or diag "system gzip -q $data failed: $?";
@a = readflex($data);
$ok &&= $#a==6;
ok $#a==6;
@a = readflex("${data}.gz");
$ok &&= $#a==6;
ok $#a==6;
shift @a;
unlink "${data}.gz", $hdr;
$d = double pdl (4*atan2(1,1));
Expand All @@ -556,29 +546,22 @@ SKIP: {
@req = ($x,$i,$l,$f,$d);
foreach (@req) {
my $h = shift @a;
$ok &&= tapprox($_,$h);
is_pdl $h, $_, "readflex compressed data";
}
ok( $ok, "readflex compressed data" );
}

# Try writing data
my $flexhdr = writeflex($data,@req);
writeflexhdr($data,$flexhdr) unless $PDL::IO::FlexRaw::writeflexhdr;
@a = readflex($data);
unlink $hdr;
$ok = 1;
foreach (@req) {
# print "$_ vs ",@a[0],"\n";
$ok &&= tapprox($_,shift @a);
is_pdl shift @a, $_, "writeflex combined data types, hdr file";
}
ok( $ok, "writeflex combined data types, hdr file" );
@a = readflex($data, $flexhdr);
$ok = 1;
foreach (@req) {
# print "$_ vs ",@a[0],"\n";
$ok &&= tapprox($_,shift @a);
is_pdl shift @a, $_, "writeflex combined data types, readflex hdr array";
}
ok( $ok, "writeflex combined data types, readflex hdr array" );
unlink $data;

$#a = -1;
Expand All @@ -593,12 +576,9 @@ $flexhdr = [ {Type => 'byte', NDims => 1, Dims => 10},
{Type => 'double', NDims => 1, Dims => 10} ];
@a = readflex($data, $flexhdr);
unlink $data;
$ok = 1;
foreach (@req) {
# print "$_ vs ",@a[0],"\n";
$ok &&= tapprox($_,slice(shift @a,"(0)"));
is_pdl slice(shift @a,"(0)"), $_, "writeflex combined types[10], readflex explicit hdr array";
}
ok( $ok, "writeflex combined types[10], readflex explicit hdr array");

# Writing multidimensional data
map {$_ = $_->dummy(0,10)} @req;
Expand All @@ -607,12 +587,9 @@ writeflexhdr($data,$flexhdr) unless $PDL::IO::FlexRaw::writeflexhdr;
@a = readflex($data);
unlink $data;
unlink $hdr;
$ok = 1;
foreach (@req) {
# print "$_ vs ",@a[0],"\n";
$ok &&= tapprox($_,shift @a);
is_pdl shift @a, $_, "multidimensional data";
}
ok( $ok, "multidimensional data" );

# Use readflex with an open file handle
@req = (byte(1..3),
Expand All @@ -623,26 +600,20 @@ $flexhdr = writeflex($data, @req);

open(IN, $data);
@a = readflex(\*IN, $flexhdr);
$ok = 1;
foreach (@req) {
# print "$_ vs ",@a[0],"\n";
$ok &&= tapprox($_,shift @a);
is_pdl shift @a, $_, "readflex with file handle";
}
close(IN);
unlink $data;
ok( $ok, "readflex with file handle" );

# use writeflex with an open file handle
open(OUT, ">$data");
$flexhdr = writeflex(\*OUT, @req);
close(OUT);
@a = readflex($data, $flexhdr);
$ok = 1;
foreach (@req) {
# print "$_ vs ",@a[0],"\n";
$ok &&= tapprox($_,shift @a);
is_pdl shift @a, $_, "writeflex with file handle";
}
unlink $data;
ok( $ok, "writeflex with file handle" );

done_testing;

0 comments on commit db685da

Please sign in to comment.