"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "IO/FlexRaw/t/flexraw.t" between
PDL-2.076.tar.gz and PDL-2.077.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

flexraw.t  (PDL-2.076):flexraw.t  (PDL-2.077)
skipping to change at line 13 skipping to change at line 13
# of this document. # of this document.
use PDL::LiteF; use PDL::LiteF;
# PDL::Core::set_debugging(1); # PDL::Core::set_debugging(1);
kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging. kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
use strict; use strict;
use warnings; use warnings;
use Test::More; use Test::More;
use PDL; use PDL::LiteF;
use File::Temp qw(tempdir); use File::Temp qw(tempdir);
use File::Spec::Functions; use File::Spec::Functions;
use PDL::IO::FlexRaw; use PDL::IO::FlexRaw;
$PDL::debug = 0; $PDL::debug = 0;
# Get a temporary directory and file name, which obviously we'll need for testin g # Get a temporary directory and file name, which obviously we'll need for testin g
# saving and reading of data. # saving and reading of data.
my $tmpdir = tempdir( CLEANUP=>1 ); my $tmpdir = tempdir( CLEANUP=>1 );
my $name = catfile($tmpdir, "tmp0"); my $name = catfile($tmpdir, "tmp0");
# Set up the working filename and make sure we're working with a clean slate: # Set up the working filename and make sure we're working with a clean slate:
# **TEST 2** save an ndarray to disk # **TEST 2** save an ndarray to disk
my $x = pdl [2,3],[4,5],[6,7]; my $x = pdl [2,3],[4,5],[6,7];
my $header = eval { writeflex($name, $x) }; my $header = eval { writeflex($name, $x) };
ok((-f $name), "writeflex should create a file"); ok((-f $name), "writeflex should create a file");
my $header_bis = [ { %{$header->[0]}, Dims => [2, undef] } ];
eval { readflex($name, [@$header_bis, @$header_bis]) };
like $@, qr/>1 header/, 'readflex only allows undef dim when only one hash';
my $x_bis = readflex($name, $header_bis);
ok(all(approx($x_bis,$x)), "read back with undef highest dim correct");
# **TEST 3** save a header to disk # **TEST 3** save a header to disk
eval { writeflexhdr($name, $header) }; eval { writeflexhdr($name, $header) };
ok(-f "$name.hdr", "writeflexhdr should create a header file"); ok(-f "$name.hdr", "writeflexhdr should create a header file");
# **TEST 4** read it back, and make sure it gives the same ndarray # **TEST 4** read it back, and make sure it gives the same ndarray
my $y = eval { readflex($name) }; my $y = eval { readflex($name) };
ok(all(approx($x,$y)), "A ndarray and its saved copy should be about equal"); ok(all(approx($x,$y)), "A ndarray and its saved copy should be about equal");
# **TEST 5** save two ndarrays to disk # **TEST 5** save two ndarrays to disk
my $c = pdl [[0,0,0,0],[0,0,0,0]]; my ($c1, $c2) = ([0,0,0,0],[0,0,0,0]);
my $c = pdl [$c1,$c2];
my $d = pdl [1,1,1]; my $d = pdl [1,1,1];
my $cdname = $name . 'cd'; my $cdname = $name . 'cd';
$header = eval { writeflex($cdname, $c, $d) }; $header = eval { writeflex($cdname, $c, $d) };
ok((-f $cdname), "writeflex saves 2 pdls to a file"); ok((-f $cdname), "writeflex saves 2 pdls to a file");
# **TEST 6** save a header to disk # **TEST 6** save a header to disk
eval { writeflexhdr($cdname, $header) }; eval { writeflexhdr($cdname, $header) };
ok(-f "$cdname.hdr", "writeflexhdr create a header file"); ok(-f "$cdname.hdr", "writeflexhdr create a header file");
# **TEST 7** read it back, and make sure it gives the same ndarray # **TEST 7** read it back, and make sure it gives the same ndarray
# This is sf.net bug #3375837 "_read_flexhdr state machine fails" # This is sf.net bug #3375837 "_read_flexhdr state machine fails"
my (@cd) = eval { no warnings; readflex($cdname) }; my (@cd) = eval { no warnings; readflex($cdname) };
ok( (scalar(@cd)==2 and all(approx($cd[0],$c)) and all(approx($cd[1],$d)) ), 'sf .net bug 3375837'); ok( (scalar(@cd)==2 and all(approx($cd[0],$c)) and all(approx($cd[1],$d)) ), 'sf .net bug 3375837');
# Clean up for another test # Clean up for another test
unlink $cdname, $cdname . '.hdr'; # just to be absolutely sure unlink $cdname, $cdname . '.hdr'; # just to be absolutely sure
{
my $gname = $name.'g';
local $PDL::IO::FlexRaw::writeflexhdr = 1;
eval { writeflex($gname, $d, $c) }; # 2D last so can append
my @dc = eval { readflex($gname) };
ok all(approx $dc[0], $d);
ok all(approx $dc[1], $c);
my $e = pdl(2,2,2,2);
eval { glueflex($gname, $e) };
is $@, '', 'no error glueflex';
@dc = eval { readflex($gname) };
ok all(approx $dc[0], $d);
ok all(approx $dc[1], pdl($c1,$c2,$e));
}
# some mapflex tests # some mapflex tests
SKIP: { SKIP: {
my $c = eval { mapflex($name) }; my $c = eval { mapflex($name) };
if ($@) { if ($@) {
diag("$@"); diag("$@");
if ($@ =~ m/mmap not supported/) { if ($@ =~ m/mmap not supported/) {
skip('no mmap support', 5); skip('no mmap support', 5);
} }
} }
 End of changes. 4 change blocks. 
2 lines changed or deleted 24 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)