1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
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;
my $tmpdir = $PDL::Config{TEMPDIR};
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:
{
# should not be run on Windows
skip( 'no mmap support on win32 (yet?)', 4) if ($^O =~ /win32/i);
# **TEST 4** compare mapfraw piddle with original piddle
my $c = mapfraw($name);
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';
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:
{
# should not be run on Windows
skip( 'no mmap support on win32 (yet?)', 1) if ($^O =~ /win32/i);
# **TEST 10** test custom headers for mapfraw
my $c = mapfraw($name,{Header => $header});
ok(tapprox($a,$c), "mapfraw should be able to work with a specified header");
}
|
