Skip to content

Commit

Permalink
IO::FITS tests replace approx with is_pdl - #34
Browse files Browse the repository at this point in the history
  • Loading branch information
@mohawk2
mohawk2 committed Oct 30, 2024
1 parent c7208ab commit 1dff102
Showing 1 changed file with 15 additions and 53 deletions.
68 changes: 15 additions & 53 deletions Basic/IO-FITS/t/fits.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ use File::Basename;
use PDL::LiteF;
use PDL::Core ':Internal'; # For howbig()
use Test::More;
use Test::PDL;
use Test::Exception;
use PDL::IO::FITS;
require File::Spec;
Expand All @@ -21,24 +22,17 @@ my $t = long xvals(zeroes(11,20))-5;
wfits($t, $file); # without a header
my $t2 = rfits $file;
unlike $t2->hdr->{COMMENT}, qr/HASH/, 'no "HASH" garbage in written header';

# note: keywords are converted to uppercase
my %hdr = ('Foo'=>'foo', 'Bar'=>42, 'NUM'=>'0123',NUMSTR=>['0123']);
$t->sethdr(\%hdr);

wfits($t, $file);
$t2 = rfits $file;

is( sum($t->slice('0:4,:')), -sum($t2->slice('5:-1,:')),
"r/wfits: slice check" );

is_pdl $t2, $t, 'w/rfits round-trip';
my $h = $t2->gethdr;
ok( $$h{FOO} eq "foo" && $$h{BAR} == 42,
"header check on FOO/BAR" );

ok( $$h{'NUM'}+1 == 124 && $$h{'NUMSTR'} eq '0123',
"header check on NUM/NUMSTR" );

unlink $file;

SKIP: {
Expand All @@ -53,28 +47,6 @@ SKIP: {
# instead they write out a file, read it back in, and
# compare to the data used to create the file.
# So it is more of a "self consistent" test.
#
sub compare_ndarrays ($$$) {
my $orig = shift;
my $new = shift;
my $label = shift;

TODO: {
local $TODO = "Need to fix alias between PDL_IND and PDL_L or PDL_LL";

is( $new->type->symbol, $orig->type->symbol, "$label has the correct type" );
}
is( $new->nelem, $orig->nelem, " and the right number of elements" );
is( $new->ndims, $orig->ndims, " and the right number of dimensions" );

my $flag;
if ( $orig->type() < float() ) {
$flag = all( $new == $orig );
} else {
$flag = all( approx( $orig, $new ) );
}
ok( $flag, " and all the values agree" );
}

unless($PDL::Astro_FITS_Header) {
# Astro::FITS::Header is not present, ignore table tests
Expand All @@ -99,8 +71,8 @@ unless($PDL::Astro_FITS_Header) {
is( $$table2{hdr}{TTYPE2}, "COLB", "column #2 is COLB" ); #11
is( $$table2{hdr}{TFORM2}, "1D", " stored as 1D" ); #12

compare_ndarrays $x, $$table2{COLA}, "COLA"; #13-16
compare_ndarrays $y, $$table2{COLB}, "COLB"; #17-20
is_pdl $x, $$table2{COLA}, "COLA"; #13-16
is_pdl $y, $$table2{COLB}, "COLB"; #17-20

$table = { BAR => $x, FOO => $y,
hdr => { TTYPE1 => 'FOO', TTYPE2 => 'BAR' } };
Expand All @@ -116,8 +88,8 @@ unless($PDL::Astro_FITS_Header) {
is( $$table2{hdr}{TTYPE2}, "BAR", "column #2 is BAR" ); #24
is( $$table2{hdr}{TFORM2}, "1J", " stored as 1J" ); #25

compare_ndarrays $x, $$table2{BAR}, "BAR"; #26-29
compare_ndarrays $y, $$table2{FOO}, "FOO"; #30-33
is_pdl $x, $$table2{BAR}, "BAR"; #26-29
is_pdl $y, $$table2{FOO}, "FOO"; #30-33

# try out more "exotic" data types

Expand All @@ -139,12 +111,8 @@ unless($PDL::Astro_FITS_Header) {
ok( defined $table2 && ref($table2) eq "HASH" && $$table2{tbl} eq "binary",
"Read in the third binary table" ); #34
my @elem = sort keys %$table2;
##my @expected = sort( qw( ACOL BCOL CCOL DCOL ECOL FCOL hdr tbl ) );
##is ( $#elem+1, 8, "hash contains 8 elements" );
my @expected = sort( qw( ACOL BCOL CCOL DCOL ECOL hdr tbl ) );
is ( $#elem+1, 7, "hash contains 7 elements" ); #35
ok( eq_array( \@elem, \@expected ), "hash contains expected
keys" ); #36
is_deeply \@elem, \@expected, "hash contains expected keys";

# convert the string array so that each element has the same length
# (and calculate the maximum length to use in the check below)
Expand Down Expand Up @@ -173,13 +141,12 @@ unless($PDL::Astro_FITS_Header) {
is( $$table2{hdr}{"TFORM$i"}, $$colinfo[1], " and is stored as $$colinfo[1]" ); #38,44,50,56,59
my $col = $$table2{$$colinfo[0]};
if ( UNIVERSAL::isa($col,"PDL") ) {
compare_ndarrays $col, $$colinfo[2], $$colinfo[0]; #39-42,45-48,51-54,60-63
is_pdl $col, $$colinfo[2], $$colinfo[0]; #39-42,45-48,51-54,60-63
} else {
# Need to somehow handle the arrays since the data read in from the
# file all have 15-character length strings (or whatever the length is)
#
ok( eq_array($col, $$colinfo[2]),
" $$colinfo[0] values agree (as an array reference)" );#57
is_deeply $col, $$colinfo[2], "$$colinfo[0] values agree (as an array reference)";
}
$i++;
}
Expand Down Expand Up @@ -321,39 +288,34 @@ if(-w dirname($tildefile)) {
{
(undef, my $fname) = File::Temp::tempfile( 'delmeXXXXX', SUFFIX => '.fits', %tmp_opts );
my $x = sequence(10)->setbadat(0);
#diag "Writing to fits: $x type = (", $x->get_datatype, ")\n";
$x->wfits($fname);
my $y = rfits($fname);
#diag "Read from fits: $y type = (", $y->get_datatype, ")\n";
ok( $y->slice('0:0')->isbad, "rfits/wfits propagated bad flag" );
ok( sum(abs($x-$y)) < 1.0e-5, " and values" );
is_pdl $y, $x, "wfits/rfits propagated bad flag and values";
# now force to integer
$x->wfits($fname,16);
$y = rfits($fname);
my $got = $y->slice('0:0');
ok( $got->isbad, "wfits coerced bad flag with integer datatype" ) or diag "got: $got (from $y)";
ok( sum(abs(convert($x,short)-$y)) < 1.0e-5, " and the values" );
is_pdl $y, $x->short, "integer wfits/rfits propagated bad flag and values";
}

{
my $m51 = rfits('t/m51.fits.fz');
is_deeply [$m51->dims], [384,384], 'right dims from compressed FITS file';
is_pdl $m51->shape, indx([384,384]), 'right dims from compressed FITS file';
(undef, my $fname) = File::Temp::tempfile( 'delmeXXXXX', SUFFIX => '.fits', %tmp_opts );
if ($PDL::Astro_FITS_Header) {
my $m51_tbl = rfits('t/m51.fits.fz',{expand=>0});
wfits($m51_tbl, $fname);
my $m51_2 = rfits($fname);
ok all(approx $m51, $m51_2), 'read back written-out bintable FITS file' or diag "got:", $m51_2->info;
is_pdl $m51_2, $m51, 'read back written-out bintable FITS file';
$m51->wfits($fname, {compress=>1});
$m51_2 = rfits($fname);
ok all(approx $m51, $m51_2), 'read back written-out compressed FITS file' or diag "got:", $m51_2->info;
is_pdl $m51_2, $m51, 'read back written-out compressed FITS file';
$m51_2->hdrcpy(1);
$m51_2 = $m51_2->dummy(2,3)->sever;
$m51_2->hdr->{NAXIS} = 3;
$m51_2->hdr->{NAXIS3} = 3;
$m51_2->wfits($fname, {compress=>1});
my $m51_3 = rfits($fname);
ok all(approx $m51_3, $m51_2), 'read back written-out compressed RGB FITS file' or diag "got:", $m51_3->info;
is_pdl $m51_3, $m51_2, 'read back written-out compressed RGB FITS file';
}
}

Expand Down

0 comments on commit 1dff102

Please sign in to comment.