The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

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;