use PDL::LiteF;
# PDL::Core::set_debugging(1);
kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
use strict;
use warnings;
# Load the testing harness and PDL
use Test::More tests => 10;
use PDL;
# Get a temporary directory and file name, which obviously we'll need for testing
# saving and reading of data.
use PDL::Config;
use File::Temp qw(tempdir);
my $tmpdir = tempdir( CLEANUP=>1 );
my $name = $tmpdir . "/tmp0";
my $header = $tmpdir . "/headerfile" . $$;
unlink $name, $name . '.hdr', $header; # just to be absolutely sure
# A function that tells us if two piddles are approximately the same
sub tapprox {
my($a,$b) = @_;
my $c = abs($a-$b);
return (max($c) < 0.01);
}
# **TEST 1** make sure FastRaw loads
BEGIN { use_ok( 'PDL::IO::FastRaw' ); }
# Set up the working filename and make sure we're working with a clean slate:
# **TEST 2** save a piddle to disk
my $a = pdl [2,3],[4,5],[6,7];
writefraw($a,$name);
ok((-f $name and -f ($name . '.hdr')), "Writing should create a file and header file");
# **TEST 3** read it back, and make sure it gives the same piddle
my $b = readfraw($name);
ok(tapprox($a,$b), "A piddle and it's saved copy should be about equal");
# some mapfraw tests
SKIP:
{
my $c = eval { mapfraw($name) };
if ($@) {
diag("$@");
if ($@ =~ m/mmap not supported/) {
skip('no mmap support', 4);
}
}
# **TEST 4** compare mapfraw piddle with original piddle
ok(tapprox($a,$c), "A piddle and it's mapfraw representation should be about equal");
# **TEST 5** modifications should be saved when $c goes out of scope
$c += 1;
undef $c;
$b = readfraw($name);
ok(tapprox($a+1,$b), "Modifications to mapfraw should be saved to disk no later than when the piddle 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
unlink $name, $name . '.hdr';
undef $a;
undef $b;
# **TEST 6** test creating a pdl via mapfraw
# First create and modify the piddle
$a = mapfraw($name, {Creat => 1, Datatype => &float, Dims => [3,2]});
$a += xvals $a;
$a += 0.1 * yvals $a;
# save the contents
undef $a;
# Load it back up and see if the values are what we expect
$b = readfraw($name);
ok(tapprox($b, PDL->pdl([[0,1,2],[0.1,1.1,2.1]])),
"mapfraw should be able to create new piddles");
# **TEST 7** test the created type
ok($b->type->[0] == (&float)->[0], 'type should be of the type we specified (float)');
}
# Clean things up a bit
unlink $name, $name . '.hdr', $header;
undef $a;
undef $b;
# Test the file header options:
# **TEST 8** test the use of a custom header for writing
$a = pdl [2,3],[4,5],[6,7];
writefraw($a,$name,{Header => $header});
ok(-f $header, "writefraw should create the special header file when specified");
# **TEST 9** test the use of a custom header for reading
$b = readfraw($name,{Header => $header});
ok(tapprox($a,$b), "Should be able to read given a specified header");
# mapfraw custom header tests
SKIP:
{
my $c = eval { mapfraw($name,{Header => $header}) };
if ($@) {
diag("$@");
if ($@ =~ m/mmap not supported/) {
skip('no mmap support', 1);
}
}
# **TEST 10** test custom headers for mapfraw
ok(tapprox($a,$c), "mapfraw should be able to work with a specified header");
}
# Clean things up for exit
unlink $name, $header;