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
|
# -*-perl-*-
# Test of the NDF I/O system
# Requires that the NDF module is available.
use strict;
use Test::More;
use PDL::LiteF;
$PDL::verbose = 1;
my $loaded;
# Check that we can load the module
BEGIN {
# Kluge loading to force NDF module to be loaded now.
# This is required since currently the PDL::IO::NDF module
# only loads the NDF module when required.
eval " use PDL::IO::NDF; use NDF";
$loaded = ( $@ ? 0 : 1 );
}
kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
unless ( $loaded ) {
plan skip_all => "PDL::IO::NDF module not available.";
} else {
plan tests => 10;
}
sub tapprox ($$) {
my ( $a, $b ) = @_;
return abs($a-$b) <= 1.0e-5;
}
# Now start by creating a test PDL
my $pdl = pdl( 1,5,10,8);
# Now add a header
$pdl->sethdr( { NDFTEST => 'yes' } );
# output file name
my $ndffile = "test.sdf";
unlink $ndffile if -e $ndffile;
# Write it out to disk
$pdl->wndf( $ndffile );
ok( -e $ndffile );
# Set up an END block to remove the file
END {
unlink $ndffile if defined $ndffile and -e $ndffile;
}
# Now read it back in
my $in = rndf( $ndffile );
# Compare the number of entries
ok( $in->dims == $pdl->dims );
# Check each entry
my $range = $pdl->getdim(0) - 1;
foreach ( 0 .. $range ) {
ok( $in->at($_) == $pdl->at($_))
}
# Now compare headers
ok( $pdl->gethdr->{NDFTEST} eq $in->gethdr->{NDFTEST} );
# try a 2D image
$pdl = pdl( [1,5,10],[8,4,-4]);
$pdl->wndf( $ndffile );
$in = rndf( $ndffile );
# Compare the number of entries
ok( $in->dims == $pdl->dims );
ok( tapprox( sum($in - $pdl), 0.0 ) );
# try a subset of the 2D image
# NOTE: NDF starts counting at 1, not 0
$in = rndf( "test(1:2,2)" );
ok( tapprox( sum($in - $pdl->slice('0:1,1') ), 0.0 ) );
# end of test
|
