1# flexraw's read/write tests, copied from fastraw's tests.
2# There are still many tests to write; see the notes at the bottom
3# of this document.
4
5use PDL::LiteF;
6# PDL::Core::set_debugging(1);
7kill INT,$$  if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
8
9use strict;
10use warnings;
11
12# Load the testing harness and PDL
13use Test::More tests => 12;
14use PDL;
15use File::Temp qw(tempdir);
16
17$PDL::debug = 0;
18
19# Get a temporary directory and file name, which obviously we'll need for testing
20# saving and reading of data.
21use PDL::Config;
22my $tmpdir = tempdir( CLEANUP=>1 );
23my $name = $tmpdir . "/tmp0";
24unlink $name, $name . '.hdr';	# just to be absolutely sure
25
26# **TEST 1** make sure FastRaw loads
27BEGIN { use_ok( 'PDL::IO::FlexRaw' ); }
28
29# Set up the working filename and make sure we're working with a clean slate:
30
31# **TEST 2** save a piddle to disk
32my $a = pdl [2,3],[4,5],[6,7];
33my $header = eval { writeflex($name, $a) };
34ok((-f $name), "writeflex should create a file");
35
36# **TEST 3** save a header to disk
37eval { writeflexhdr($name, $header) };
38ok(-f "$name.hdr", "writeflexhdr should create a header file");
39
40# **TEST 4** read it back, and make sure it gives the same piddle
41my $b = eval { readflex($name) };
42ok(all(approx($a,$b)), "A piddle and it's saved copy should be about equal");
43
44# **TEST 5** save two piddles to disk
45my $c = pdl [[0,0,0,0],[0,0,0,0]];
46my $d = pdl [1,1,1];
47my $cdname = $name . 'cd';
48$header = eval { writeflex($cdname, $c, $d) };
49ok((-f $cdname), "writeflex saves 2 pdls to a file");
50
51# **TEST 6** save a header to disk
52eval { writeflexhdr($cdname, $header) };
53ok(-f "$cdname.hdr", "writeflexhdr create a header file");
54
55# **TEST 7** read it back, and make sure it gives the same piddle
56# This is sf.net bug #3375837 "_read_flexhdr state machine fails"
57my (@cd) = eval { no warnings; readflex($cdname) };
58ok( (scalar(@cd)==2 and all(approx($cd[0],$c)) and all(approx($cd[1],$d)) ), 'sf.net bug 3375837');
59
60# Clean up for another test
61unlink $cdname, $cdname . '.hdr';	# just to be absolutely sure
62
63# some mapflex tests
64SKIP: {
65
66   my $c = eval { mapflex($name) };
67   if ($@) {
68      diag("$@");
69      if ($@ =~ m/mmap not supported/) {
70         skip('no mmap support', 5);
71      }
72   }
73
74   # **TEST 8** compare mapfraw piddle with original piddle
75   ok(all(approx($a,$c)), "A piddle and it's mapflex representation should be about equal");
76
77   # **TEST 9** modifications should be saved when $c goes out of scope
78   # THIS TEST FAILS.
79   # This failure is recorded in sf.net bug 3031068.
80   # Presently, making $c go out of scope does not free the memory
81   # mapping associated with mapflex, so this modification is never
82   # saved to the file (or at least it's not saved immediately).
83   $c += 1;
84   undef $c;
85   $b = readflex($name);
86   ok(all(approx($a+1,$b)), "Modifications to mapfraw should be saved to disk no later than when the piddle ceases to exist");
87
88   # We're starting a new test, so we'll remove the files we've created so far
89   # and clean up the memory, just to be super-safe
90   unlink $name, $name . '.hdr';
91   undef $a;
92   undef $b;
93
94   # **TEST 10** test creating a pdl via mapfraw
95   # First create and modify the piddle
96   $header = [{NDims => 2, Dims => [3,2], Type => 'float'}];
97   # Fix this specification.
98   $a = mapflex($name, $header, {Creat => 1});
99   writeflexhdr($name, $header);
100   ok(defined($a), 'mapflex create piddle');
101
102   skip('no mapflex piddle to check', 2) unless defined $a;
103   $a += xvals $a;
104   $a += 0.1 * yvals $a;
105   # save the contents
106   undef $a;
107   # Load it back up and see if the values are what we expect
108   $b = readflex($name);
109   # **TEST 11**
110   ok(all(approx($b, PDL->pdl([[0,1,2],[0.1,1.1,2.1]]))),
111      "mapfraw should be able to create new piddles");
112
113   # **TEST 12** test the created type
114   ok($b->type->[0] == (&float)->[0], 'type should be of the type we specified (float)');
115
116}
117
118# Clean things up a bit
119unlink $name, $name . '.hdr';
120undef $a;
121undef $b;
122
123# Test the file header options:
124
125# Tests to write still:
126# Test using file handles instead of file names
127# test read_flexhdr
128# test gzip stuff
129