diff --git a/IO/FITS/FITS.pm b/IO/FITS/FITS.pm index 295dd5049..56311eb06 100644 --- a/IO/FITS/FITS.pm +++ b/IO/FITS/FITS.pm @@ -1220,6 +1220,8 @@ our $tile_compressors = { die "rfits: error while loading PDL::Compression to pack tile-compressed image.\n\t$@\n" if $@; my ($tiles, $tbl, $params) = @_; my $blocksize = $params->{BLOCKSIZE} || 32; + my $tiles_ndims = $tiles->ndims; + $tiles = $tiles->clump(1..$tiles_ndims-1) if $tiles_ndims > 2; my ($compressed,undef,undef,$len) = $tiles->rice_compress($blocksize); $tbl->{ZNAME1} = "BLOCKSIZE"; $tbl->{ZVAL1} = $blocksize; diff --git a/IO/FITS/t/fits.t b/IO/FITS/t/fits.t index 5d9333a49..abffe714c 100644 --- a/IO/FITS/t/fits.t +++ b/IO/FITS/t/fits.t @@ -339,15 +339,21 @@ ok( sum(abs(convert($x,short)-$y)) < 1.0e-5, " and the values" ); my $m51 = rfits('t/m51.fits.fz'); is_deeply [$m51->dims], [384,384], 'right dims from compressed FITS file'; (undef, my $fname) = File::Temp::tempfile( 'delmeXXXXX', SUFFIX => '.fits', %tmp_opts ); -my $m51_2; if ($PDL::Astro_FITS_Header) { my $m51_tbl = rfits('t/m51.fits.fz',{expand=>0}); wfits($m51_tbl, $fname); -$m51_2 = rfits($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; $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; +$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; } }