Skip to content

Commit

Permalink
test tweaks
Browse files Browse the repository at this point in the history
  • Loading branch information
@mohawk2
mohawk2 committed Apr 26, 2022
1 parent 4e39dcd commit 90f794e
Show file tree
Hide file tree
Showing 2 changed files with 93 additions and 98 deletions.
49 changes: 25 additions & 24 deletions t/01-Netcdf3.t
View file
Original file line number Diff line number Diff line change
@@ -1,27 +1,29 @@
use Test::More;
use warnings;
use strict;
use warnings;
use Test::More;
use Fcntl;
use FindBin qw($Bin);
BEGIN { use_ok('PDL') };
BEGIN { use_ok('PDL::NetCDF') };
BEGIN { use_ok('PDL::Char') };
BEGIN { note( "Removing test file $_\n" ), unlink foreach grep -e, qw/ foo.nc foo1.nc do_not_create.nc / }
END { note( "Removing test file $_\n" ), unlink foreach grep -e, qw/ bogus.nc foo.nc foo1.nc / }
use PDL;
use PDL::NetCDF;
use PDL::Char;
use File::Temp qw/ tempdir /;
use File::Spec::Functions;

sub vnorm2 { sumover(shift()**2.)->sqrt } # Euclidean vector norm
my $dir = tempdir(CLEANUP=>1);

#
## Test object-oriented interface
#

# Test whether PDL::NetCDF honours `O_RDONLY' when trying to open a nonexistent file
eval { PDL::NetCDF->new( 'do_not_create.nc', { MODE => O_RDONLY } ) };
my $dnc = catfile($dir, 'do_not_create.nc');
eval { PDL::NetCDF->new( $dnc, { MODE => O_RDONLY } ) };
like( $@, qr/Cannot open readonly! No such file/, 'PDL::NetCDF should complain when opening nonexistent file when O_RDONLY is in effect' );
ok( ! -f 'do_not_create.nc', 'PDL::NetCDF must not create new file when O_RDONLY is in effect' );
ok( ! -f $dnc, 'PDL::NetCDF must not create new file when O_RDONLY is in effect' );

# Test starting with new file
my $obj = PDL::NetCDF->new ('foo.nc');
my $newfile = catfile($dir, 'foo.nc');
my $obj = PDL::NetCDF->new ($newfile);
my $in1 = pdl [[1,2,3], [4,5,6]];
$obj->put ('var1', ['dim1', 'dim2'], $in1);
my $out1 = $obj->get ('var1');
Expand Down Expand Up @@ -92,13 +94,13 @@ cmp_ok(vnorm2($pdlcomp - $correct), '<', $tol, "Compressed put/get 2");
ok(!$obj->close, "Compressed put/get 3");

# try a fast open
my $nc1 = PDL::NetCDF->new('foo.nc', {TEMPLATE => $obj});
my $nc1 = PDL::NetCDF->new($newfile, {TEMPLATE => $obj});
my $varnames = $nc1->getvariablenames;
ok(grep(/^var1$/,@$varnames) + grep(/^textvar$/,@$varnames), "Fast open 1");
ok(!$nc1->close, "Fast open 2");

# Try rewriting an existing file
my $obj1 = PDL::NetCDF->new ('>foo.nc', {PERL_SCALAR => 1, PDL_BAD => 1});
my $obj1 = PDL::NetCDF->new (">$newfile", {PERL_SCALAR => 1, PDL_BAD => 1});
$varnames = $obj1->getvariablenames;
ok(grep(/^var1$/,@$varnames) + grep(/^textvar$/,@$varnames), "Re-writing 1");

Expand Down Expand Up @@ -187,14 +189,13 @@ is($shuffle, 0, 'unshuffled variable');


# Test with a bogus file
open (IN, ">bogus.nc");
print IN "I'm not a netCDF file\n";
close IN;
my $obj2;
eval { $obj2 = PDL::NetCDF->new ('bogus.nc'); };
my $bogus = catfile($dir, 'bogus.nc');
{ open my $fh, ">", $bogus; print $fh "I'm not a netCDF file\n"; }
eval { my $obj2 = PDL::NetCDF->new ($bogus); };
like $@, qr/(Not a netCDF file|Unknown file format)/, "Read bogus file";

$obj = PDL::NetCDF->new ('foo1.nc');
my $newfile2 = catfile($dir, 'foo1.nc');
$obj = PDL::NetCDF->new ($newfile2);
# test chars with unlimited dimension
my $strlen = 5;
my $id = 0;
Expand All @@ -215,9 +216,9 @@ my $charout2 = $obj->get('char_unlim', [0,0], [1, $strlen]);
ok (($charout2->dims)[0] == $strlen, "Getting exactly one string from nc with unlimited dimension");

$obj->close;
unlink 'foo1.nc';
unlink $newfile2;

$obj = PDL::NetCDF->new ('>foo1.nc');
$obj = PDL::NetCDF->new (">$newfile2");
my $nullPdl = new PDL::Char("");
$obj->put('dimless_var', [],$nullPdl);
ok(${ $obj->getvariablenames }[0] eq 'dimless_var', 'adding dimless char variable');
Expand All @@ -229,14 +230,14 @@ $obj->close;

$obj = undef;

$obj = PDL::NetCDF->new('foo.nc');
$obj = PDL::NetCDF->new($newfile);
$obj->close;
$obj = PDL::NetCDF->new('foo.nc');
$obj = PDL::NetCDF->new($newfile);
$obj->getatt("text_attribute");
ok(1, "close is idempotent");

# check reading of string slices
$obj = PDL::NetCDF->new("$Bin/threedimstring.nc", {MODE => O_RDONLY,
$obj = PDL::NetCDF->new(catfile(qw(t threedimstring.nc)), {MODE => O_RDONLY,
REVERSE_DIMS => 1,
SLOW_CHAR_FETCH => 1});
my $varname = 'threedimstring';
Expand Down
142 changes: 68 additions & 74 deletions t/02-Netcdf4.t
View file
Original file line number Diff line number Diff line change
@@ -1,87 +1,81 @@
# -*- Perl -*-
use Test::More;
use Data::Dumper;
use strict;
use warnings;
use Test::More;
use PDL::Lite ();
use PDL::NetCDF;
use Data::Dumper;
END { note( "Removing test file $_\n" ), unlink foreach grep -e, qw/ foo.nc / }
use File::Temp qw/ tempdir /;
use File::Spec::Functions;

my $isNetCDF = PDL::NetCDF::isNetcdf4();
isnt $isNetCDF, undef, "isNetcdf4 function defined";
plan skip_all => "no netcdf4 support" unless PDL::NetCDF::isNetcdf4;

my $dir = -d "t" ? "t/" : "./";
SKIP: {
skip "no netcdf4 support", 19 unless PDL::NetCDF::isNetcdf4;
is(PDL::NetCDF::defaultFormat(), PDL::NetCDF::NC_FORMAT_CLASSIC, "classic format is default");
is(PDL::NetCDF::defaultFormat(), PDL::NetCDF::NC_FORMAT_CLASSIC, "classic format is still default");
my $nc4 = PDL::NetCDF->new($dir . "foo.nc4", {REVERSE_DIMS => 1});
isa_ok($nc4, 'PDL::NetCDF');
is ($nc4->getFormat, PDL::NetCDF::NC_FORMAT_NETCDF4, "foo.nc4 is netcdf4");
is($nc4->getatt('text_attribute'), "Text Attribute");
# print Dumper($nc4->{VARIDS});
my ($deflate, $shuffle) = $nc4->getDeflateShuffle('var1');
is($deflate, 0, 'uncompressed variable');
is($shuffle, 0, 'unshuffled variable');
my $dir = tempdir(CLEANUP=>1);
is(PDL::NetCDF::defaultFormat(), PDL::NetCDF::NC_FORMAT_CLASSIC, "classic format is default");
is(PDL::NetCDF::defaultFormat(), PDL::NetCDF::NC_FORMAT_CLASSIC, "classic format is still default");
my $nc4 = PDL::NetCDF->new(catfile(qw(t foo.nc4)), {REVERSE_DIMS => 1});
isa_ok($nc4, 'PDL::NetCDF');
is ($nc4->getFormat, PDL::NetCDF::NC_FORMAT_NETCDF4, "foo.nc4 is netcdf4");
is($nc4->getatt('text_attribute'), "Text Attribute");
my ($deflate, $shuffle) = $nc4->getDeflateShuffle('var1');
is($deflate, 0, 'uncompressed variable');
is($shuffle, 0, 'unshuffled variable');

# tests on a new file
my $bar = $dir.'bar.nc4';
unlink $bar if -f $bar;
my $format = PDL::NetCDF::defaultFormat(PDL::NetCDF::NC_FORMAT_NETCDF4_CLASSIC);
is($format, PDL::NetCDF::NC_FORMAT_CLASSIC, "got old format");
is(PDL::NetCDF::defaultFormat(), PDL::NetCDF::NC_FORMAT_NETCDF4_CLASSIC, "switching default-format");
my $nc = PDL::NetCDF->new($bar, {REVERSE_DIMS => 1});
isa_ok($nc, 'PDL::NetCDF');
is ($nc->getFormat, PDL::NetCDF::NC_FORMAT_NETCDF4_CLASSIC, $bar ." is netcdf4");
$nc->close;
unlink $bar if -f $bar;
$nc = PDL::NetCDF->new($bar, {REVERSE_DIMS => 1, NC_FORMAT => PDL::NetCDF::NC_FORMAT_NETCDF4});
is ($nc->getFormat, PDL::NetCDF::NC_FORMAT_NETCDF4, $bar ." is netcdf4");
my $pdl = PDL::Basic::sequence(3, 2);
$nc->put ('var1', ['dim1', 'dim2'], $pdl, {DEFLATE => 7, SHUFFLE => 1});
ok(1, "put with deflate");
ok(eq_array([7,1], [$nc->getDeflateShuffle('var1')]), "deflateShuffle for var1");
$nc->putslice('var2', ['dim1','dim2','dim3'],[3,2,2],[0,0,0],[3,2,1],$pdl, {DEFLATE => 8, SHUFFLE => 1});
ok(1, "putslice with deflate");
$nc->sync();
ok(1, "sync on nc4");
ok(eq_array([8,1], [$nc->getDeflateShuffle('var2')]), "deflateShuffle for var2");
my $outPdl = $nc->get('var1');
ok(1, 'get deflated variable');
ok(eq_array([$outPdl->list], [$pdl->list]), "write/read equal");
# tests on a new file
my $bar = catfile($dir, "bar.nc4");
my $format = PDL::NetCDF::defaultFormat(PDL::NetCDF::NC_FORMAT_NETCDF4_CLASSIC);
is($format, PDL::NetCDF::NC_FORMAT_CLASSIC, "got old format");
is(PDL::NetCDF::defaultFormat(), PDL::NetCDF::NC_FORMAT_NETCDF4_CLASSIC, "switching default-format");
my $nc = PDL::NetCDF->new($bar, {REVERSE_DIMS => 1});
isa_ok($nc, 'PDL::NetCDF');
is ($nc->getFormat, PDL::NetCDF::NC_FORMAT_NETCDF4_CLASSIC, $bar ." is netcdf4");
$nc->close;
unlink $bar if -f $bar;
$nc = PDL::NetCDF->new($bar, {REVERSE_DIMS => 1, NC_FORMAT => PDL::NetCDF::NC_FORMAT_NETCDF4});
is ($nc->getFormat, PDL::NetCDF::NC_FORMAT_NETCDF4, $bar ." is netcdf4");
my $pdl = PDL::Basic::sequence(3, 2);
$nc->put ('var1', ['dim1', 'dim2'], $pdl, {DEFLATE => 7, SHUFFLE => 1});
ok(1, "put with deflate");
ok(eq_array([7,1], [$nc->getDeflateShuffle('var1')]), "deflateShuffle for var1");
$nc->putslice('var2', ['dim1','dim2','dim3'],[3,2,2],[0,0,0],[3,2,1],$pdl, {DEFLATE => 8, SHUFFLE => 1});
ok(1, "putslice with deflate");
$nc->sync();
ok(1, "sync on nc4");
ok(eq_array([8,1], [$nc->getDeflateShuffle('var2')]), "deflateShuffle for var2");
my $outPdl = $nc->get('var1');
ok(1, 'get deflated variable');
ok(eq_array([$outPdl->list], [$pdl->list]), "write/read equal");

# fillvalues
eval { $nc->put('var3', ['dim1', 'dim2'], $pdl, {DEFLATE => 7, SHUFFLE => 1, _FillValue => 5}) };
is($@, '', "put with deflate and _FillValue");
$nc->sync;
my $pOut = eval { $nc->get('var3',{PDL_BAD => 1}) };
is($@, '', "retrieved var3");
if (defined $pOut) {
ok($pOut->isbad->sum == 1, "default fill-value detected in nc") or diag "got:$pOut";
}
eval { $nc->putslice('var4', ['dim1','dim2','dim3'],[3,2,2],[0,0,0],[3,2,1],$pdl, {DEFLATE => 8, SHUFFLE => 1, _FillValue => 5}) };
is($@, '', "putslice with deflate and _FillValue");
ok(eq_array([8,1], [$nc->getDeflateShuffle('var4')]), "deflateShuffle for var4");
# default fill value
my $pdlFill = $pdl->copy;
$pdlFill->slice("0,0") .= PDL::NetCDF::NC_FILL_FLOAT();
$nc->put ('var5', ['dim1', 'dim2'], $pdlFill, {DEFLATE => 7, SHUFFLE => 1});
ok(1, "put with deflate and no _FillValue");
$nc->sync;
$pOut = $nc->get('var5',{PDL_BAD => 1});
ok(($pOut->isbad)->sum == 1, "default fill-value detected in nc");
# fillvalues
eval { $nc->put('var3', ['dim1', 'dim2'], $pdl, {DEFLATE => 7, SHUFFLE => 1, _FillValue => 5}) };
is($@, '', "put with deflate and _FillValue");
$nc->sync;
my $pOut = eval { $nc->get('var3',{PDL_BAD => 1}) };
is($@, '', "retrieved var3");
if (defined $pOut) {
ok($pOut->isbad->sum == 1, "default fill-value detected in nc") or diag "got:$pOut";
}
eval { $nc->putslice('var4', ['dim1','dim2','dim3'],[3,2,2],[0,0,0],[3,2,1],$pdl, {DEFLATE => 8, SHUFFLE => 1, _FillValue => 5}) };
is($@, '', "putslice with deflate and _FillValue");
ok(eq_array([8,1], [$nc->getDeflateShuffle('var4')]), "deflateShuffle for var4");
# default fill value
my $pdlFill = $pdl->copy;
$pdlFill->slice("0,0") .= PDL::NetCDF::NC_FILL_FLOAT();
$nc->put ('var5', ['dim1', 'dim2'], $pdlFill, {DEFLATE => 7, SHUFFLE => 1});
ok(1, "put with deflate and no _FillValue");
$nc->sync;
$pOut = $nc->get('var5',{PDL_BAD => 1});
ok(($pOut->isbad)->sum == 1, "default fill-value detected in nc");

unlink $bar if -f $bar;
unlink $bar if -f $bar;

# Test writing and reading the new string attribute
unlink "foo.nc" if -f "foo.nc";
$nc = PDL::NetCDF->new (">foo.nc");
my $in1 = PDL->pdl([[1,2,3], [4,5,6]]);
$nc->put ('var1', ['dim1', 'dim2'], $in1);
$nc->putatt(['string1', 'another_string'], 'string_attr', 'var1'); # Put two strings as attributes to 'var1'
my $strattr = $nc->getatt('string_attr', 'var1');
ok($strattr->[0] eq 'string1' && $strattr->[1] eq 'another_string', "Put/get string attribute");
$nc->close();
}
# Test writing and reading the new string attribute
my $newfile = catfile($dir, 'foo.nc');
$nc = PDL::NetCDF->new (">$newfile");
my $in1 = PDL->pdl([[1,2,3], [4,5,6]]);
$nc->put ('var1', ['dim1', 'dim2'], $in1);
$nc->putatt(['string1', 'another_string'], 'string_attr', 'var1'); # Put two strings as attributes to 'var1'
my $strattr = $nc->getatt('string_attr', 'var1');
ok($strattr->[0] eq 'string1' && $strattr->[1] eq 'another_string', "Put/get string attribute");
$nc->close();
done_testing;

0 comments on commit 90f794e

Please sign in to comment.