1use strict; 2 3use vars qw( $OK_column $loaded $tests_ran $tests_failed ); 4 5BEGIN { 6 $| = 1; 7 $OK_column = 40; 8 $loaded = 0; 9 $tests_ran = 0; 10 $tests_failed = 0; 11 12 sub pre_test { 13 print $_[0],'.'x($OK_column-length($_[0])-1); 14 } 15 16 sub post_test { 17 print $_[0] ? 'ok' : 'not ok',"\n"; 18 $tests_ran++; 19 $tests_failed++ unless $_[0]; 20 } 21 22 print "\n"; 23 pre_test('Loading'); # get this in before 'use Astro::FITS::CFISTIO' 24} 25 26use Astro::FITS::CFITSIO qw( :shortnames :constants PerlyUnpacking ); 27$loaded = 1; 28post_test($loaded); 29 30my $template = './testprog/testprog.tpt'; 31 32END { 33 post_test(0) unless $loaded; 34 summarize_tests(); 35 print <<EOP; 36 37This is beta software, and the test suite is not yet complete. 38You may find the scripts in ./testprog and ./examples of interest, 39however. 40 41EOP 42 43} 44 45sub summarize_tests { 46 print <<EOP; 47 48${\($tests_ran-$tests_failed)} / $tests_ran tests passed (${\(sprintf("%.1f",100*(1-$tests_failed/$tests_ran)))}%) 49 50EOP 51 52} 53 54# 55# compare two numeric arrays, returning true if they are identical 56# 57sub cmp_num_arrays { 58 my ($r1,$r2) = @_; 59 (@$r1 == @$r2) or return; # number of elements is not identical 60 for (my $i=0; $i<@$r1; $i++) { 61 ($r1->[$i] == $r2->[$i]) or return; 62 } 63 return 1; 64} 65 66# 67# compare two string arrays, returning true if they are identical 68# 69sub cmp_str_arrays { 70 my ($r1,$r2) = @_; 71 (@$r1 == @$r2) or return; # number of elements is not identical 72 for (my $i=0; $i<@$r1; $i++) { 73 ($r1->[$i] eq $r2->[$i]) or return; 74 } 75 return 1; 76} 77 78my $status = 0; 79 80# fits_get_keyname 81my $name; 82pre_test('ffgknm'); 83ffgknm("TESTING 'This is a test'",$name,undef,$status); 84post_test($name eq 'TESTING'); 85 86# cfitsio version 2.100 or better? 87pre_test('ffvers'); 88post_test(ffvers(undef) > 2.09); 89 90# try to open non-existant file 91pre_test('ffopen'); 92$status = 0; 93my $fptr; 94ffopen($fptr,'tq123x.kjl',READWRITE,$status); 95print "\nSTATUS = $status\n"; 96post_test(104 == $status); 97 98# fits_create_file 99$status = 0; 100pre_test('ffinit'); 101ffinit($fptr,'!testprog.fit',$status); 102post_test(0 == $status); 103 104# fits_file_name 105pre_test('ffflnm'); 106my $filename; 107ffflnm($fptr,$filename,$status); 108post_test($filename eq 'testprog.fit'); 109 110# fits_file_mode 111pre_test('ffflmd'); 112my $filemode; 113ffflmd($fptr,$filemode,$status); 114post_test(1 == $filemode); 115 116my ($simple,$bitpix,$naxis,$naxes,$npixels,$pcount,$gcount,$extend) = 117 (1,32,2,[10,2],20,0,1,1); 118 119# fits_write_imghdr 120pre_test('ffphps'); 121post_test(ffphps($fptr,$bitpix,$naxis,$naxes,$status) == 0); 122 123# fits_write_record 124pre_test('ffprec'); 125post_test( 126 ffprec( 127 $fptr, 128 "key_prec= 'This keyword was written by fxprec' / comment goes here", 129 $status 130 ) == 0 131); 132 133# fits_write_key_str 134pre_test('ffpkys/ffgkey'); 135my $card = 136 "1234567890123456789012345678901234567890" . 137 "12345678901234567890123456789012345"; 138my $card2; 139ffpkys($fptr,"card1",$card,"",$status); 140ffgkey($fptr,'card1',$card2,undef,$status); 141post_test($card2 eq q/'12345678901234567890123456789012345678901234567890123456789012345678'/); 142 143pre_test('ffpkys/ffgkey'); 144$card = 145 "1234567890123456789012345678901234567890" . 146 "123456789012345678901234'6789012345"; 147ffpkys($fptr,'card2',$card,"",$status); 148ffgkey($fptr,'card2',$card2,undef,$status); 149post_test($card2 eq q/'1234567890123456789012345678901234567890123456789012345678901234''67'/); 150 151pre_test('ffpkys/ffgkey'); 152$card = 153 "1234567890123456789012345678901234567890" . 154 "123456789012345678901234''789012345"; 155ffpkys($fptr,'card3',$card,"",$status); 156ffgkey($fptr,'card3',$card2,undef,$status); 157post_test($card2 eq q/'1234567890123456789012345678901234567890123456789012345678901234'''''/); 158 159pre_test('ffpkys/ffgkey'); 160$card = 161 "1234567890123456789012345678901234567890" . 162 "123456789012345678901234567'9012345"; 163ffpkys($fptr,'card4',$card,"",$status); 164ffgkey($fptr,'card4',$card2,undef,$status); 165post_test($card2 eq q/'1234567890123456789012345678901234567890123456789012345678901234567'/); 166 167 168# 169# test writing of various types of keywords 170# 171my $oskey='value_string'; 172my $olkey=1; 173my $ojkey=11; 174my $otint = 12345678; 175my $ofkey = 12.121212; 176my $oekey = 13.131313; 177my $ogkey = 14.1414141414141414; 178my $odkey = 15.1515151515151515; 179my $otfrac = 0.1234567890123456; 180my $onekey = [13.131313, 14.141414, 15.151515]; 181my $ondkey = [15.1515151515151515, 16.1616161616161616,17.1717171717171717]; 182 183pre_test('ffpkys'); 184post_test(ffpkys($fptr,'key_pkys',$oskey,'fxpkys comment',$status) == 0); 185 186pre_test('ffpkyl'); 187post_test(ffpkyl($fptr,'key_pkyl',$olkey,'fxpkyl comment',$status) == 0); 188 189pre_test('ffpkyj'); 190post_test(ffpkyj($fptr,'key_pkyj',$ojkey,'fxpkyj comment',$status) == 0); 191 192pre_test('ffpkyf'); 193post_test(ffpkyf($fptr,'key_pkyf',$ofkey,5,'fxpkyf comment',$status) == 0); 194 195pre_test('ffpkye'); 196post_test(ffpkye($fptr,'key_pkye',$oekey,6,'fxpkye comment',$status) == 0); 197 198pre_test('ffpkyg'); 199post_test(ffpkyg($fptr,'key_pkyg',$ogkey,14,'fxpkyg comment',$status) == 0); 200 201pre_test('ffpkyd'); 202post_test(ffpkyd($fptr,'key_pkyd',$odkey,14,'fxpkyd comment',$status) == 0); 203 204pre_test('ffpkyc'); 205post_test(ffpkyc($fptr,'key_pkyc',$onekey,6,'fxpkyc comment',$status) == 0); 206 207pre_test('ffpkym'); 208post_test(ffpkym($fptr,'key_pkym',$ondkey,14,'fxpkym comment',$status) == 0); 209 210pre_test('ffpkfc'); 211post_test(ffpkfc($fptr,'key_pkfc',$onekey,6,'fxpkfc comment',$status) == 0); 212 213pre_test('ffpkfm'); 214post_test(ffpkfm($fptr,'key_pkfm',$ondkey,14,'fxpkfm comment',$status) == 0); 215 216pre_test('ffpkls'); 217post_test( 218 ffpkls( 219 $fptr, 220 'key_pkls', 221 'This is a very long string value that is continued over more than one keyword.', 222 'fxpkls comment', 223 $status, 224 ) == 0 225); 226 227pre_test('ffplsw'); 228post_test(ffplsw($fptr,$status) == 0); 229 230pre_test('ffpkyt'); 231post_test(ffpkyt($fptr,'key_pkyt',$otint,$otfrac,'fxpkyt comment',$status)==0); 232 233pre_test('ffpcom'); 234post_test(ffpcom($fptr,'This keyword was written by fxpcom.',$status) == 0); 235 236pre_test('ffphis'); 237post_test(ffphis($fptr," This keyword written by fxphis (w/ 2 leading spaces).",$status) == 0); 238 239pre_test('ffpdat'); 240post_test(ffpdat($fptr,$status) == 0); 241 242my $onskey = [ 'first string', 'second string', ' ' ]; 243my $onlkey = [1,0,1]; 244my $onjkey = [11,12,13]; 245my $onfkey = [12.121212, 13.131313, 14.141414]; 246my $ongkey = [14.1414141414141414, 15.1515151515151515,16.1616161616161616]; 247 248my $nkeys = 3; 249 250pre_test('ffpkns'); 251post_test(ffpkns($fptr,'ky_pkns',1,$nkeys,$onskey,'fxpkns comment&',$status) == 0); 252 253pre_test('ffpknl'); 254post_test(ffpknl($fptr,'ky_pknl',1,$nkeys,$onlkey,'fxpknl comment&',$status) == 0); 255 256pre_test('ffpknj'); 257post_test(ffpknj($fptr,'ky_pknj',1,$nkeys,$onjkey,'fxpknj comment&',$status) == 0); 258 259pre_test('ffpknf'); 260post_test(ffpknf($fptr,'ky_pknf',1,$nkeys,$onfkey,5,'fxpknf comment&',$status) == 0); 261 262pre_test('ffpkne'); 263post_test(ffpkne($fptr,'ky_pkne',1,$nkeys,$onekey,6,'fxpkne comment&',$status) == 0); 264 265pre_test('ffpkng'); 266post_test(ffpkng($fptr,'ky_pkng',1,$nkeys,$ongkey,13,'fxpkng comment&',$status) == 0); 267 268pre_test('ffpknd'); 269post_test(ffpknd($fptr,'ky_pknd',1,$nkeys,$ondkey,14,'fxpknd comment&',$status) == 0); 270 271pre_test('ffpky/TSTRING'); 272$oskey = 1; 273post_test(ffpky($fptr,TSTRING,'tstring',$oskey,'tstring comment',$status) == 0); 274 275pre_test('ffpky/TLOGICAL'); 276$olkey = TLOGICAL; 277post_test(ffpky($fptr,TLOGICAL,'tlogical',$olkey,'tlogical comment',$status) == 0); 278 279pre_test('ffpky/TBYTE'); 280my $cval = TBYTE; 281post_test(ffpky($fptr,TBYTE,'tbyte',$cval,'tbyte comment',$status) == 0); 282 283pre_test('ffpky/TSHORT'); 284my $oshtkey = TSHORT; 285post_test(ffpky($fptr,TSHORT,'tshort',$oshtkey,'tshort comment',$status) == 0); 286 287pre_test('ffpky/TINT'); 288$olkey = TINT; 289post_test(ffpky($fptr,TINT,'tint',$olkey,'tint comment',$status) == 0); 290 291pre_test('ffpky/TLONG'); 292$ojkey = TLONG; 293post_test(ffpky($fptr,TLONG,'tlong',$ojkey,'tlong comment',$status) == 0); 294 295pre_test('ffpky/TFLOAT'); 296$oekey = TFLOAT; 297post_test(ffpky($fptr,TFLOAT,'tfloat',$oekey,'tfloat comment',$status) == 0); 298 299pre_test('ffpky/TDOUBLE'); 300$odkey = TDOUBLE; 301post_test(ffpky($fptr,TDOUBLE,'tdouble',$odkey,'tdouble comment',$status) == 0); 302 303pre_test('ffpkyj'); 304post_test(ffpkyj($fptr,'BLANK',-99,'value to use for undefined pixels',$status) == 0); 305 306my $boutarray = [1..$npixels]; 307my $ioutarray = [1..$npixels]; 308my $joutarray = [1..$npixels]; 309my $eoutarray = [1..$npixels]; 310my $doutarray = [1..$npixels]; 311 312pre_test('ffpprX'); 313ffpprb($fptr,1,1,2,[@{$boutarray}[0..1]],$status); 314ffppri($fptr,1,5,2,[@{$ioutarray}[4..5]],$status); 315ffpprj($fptr,1,9,2,[@{$joutarray}[8..9]],$status); 316ffppre($fptr,1,13,2,[@{$eoutarray}[12..13]],$status); 317ffpprd($fptr,1,17,2,[@{$doutarray}[16..17]],$status); 318ffppnb($fptr,1,3,2,[@{$boutarray}[2..3]],4,$status); 319ffppni($fptr,1,7,2,[@{$ioutarray}[6..7]],8,$status); 320ffppnj($fptr,1,11,2,[@{$joutarray}[10..11]],12,$status); 321ffppne($fptr,1,15,2,[@{$eoutarray}[14..15]],16,$status); 322ffppnd($fptr,1,19,2,[@{$doutarray}[18..19]],20,$status); 323ffppru($fptr,1,1,1,$status); 324post_test($status == 0); 325 326pre_test('ffflus'); 327ffflus($fptr,$status); 328post_test($status == 0); 329 330my $hdunum; 331pre_test('ffghdn'); 332post_test(ffghdn($fptr,$hdunum) == 1); 333 334my $standard = [qw(99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99)]; 335my $anynull = 0; 336 337pre_test('ffpprb/ffgpvb'); 338my $binarray; 339ffgpvb($fptr,1,1,$npixels,99,$binarray,$anynull,$status); 340post_test(cmp_num_arrays($binarray,$standard) and $anynull == 1); 341 342pre_test('ffppri/ffgpvi'); 343my $iinarray; 344ffgpvi($fptr,1,1,$npixels,99,$iinarray,$anynull,$status); 345post_test(cmp_num_arrays($iinarray,$standard) and $anynull == 1); 346 347pre_test('ffpprj/ffgpvj'); 348my $jinarray; 349ffgpvj($fptr,1,1,$npixels,99,$jinarray,$anynull,$status); 350post_test(cmp_num_arrays($jinarray,$standard) and $anynull == 1); 351 352pre_test('ffppre/ffgpve'); 353my $einarray; 354ffgpve($fptr,1,1,$npixels,99,$einarray,$anynull,$status); 355post_test(cmp_num_arrays($einarray,$standard) and $anynull == 1); 356 357pre_test('ffpprd/ffgpvd'); 358my $dinarray; 359ffgpvd($fptr,1,1,$npixels,99,$dinarray,$anynull,$status); 360post_test(cmp_num_arrays($dinarray,$standard) and $anynull == 1); 361 362@$boutarray = @$binarray; 363@$ioutarray = @$iinarray; 364@$joutarray = @$jinarray; 365@$eoutarray = @$einarray; 366@$doutarray = @$dinarray; 367 368@$binarray = map(0,(0..$npixels-1)); 369@$iinarray = map(0,(0..$npixels-1)); 370@$jinarray = map(0,(0..$npixels-1)); 371@$einarray = map(0,(0..$npixels-1)); 372@$dinarray = map(0,(0..$npixels-1)); 373 374$anynull = 0; 375$standard = [qw( * 2 3 * 5 6 7 * 9 10 11 * 13 14 15 * 17 18 19 * )]; 376my $larray; 377 378pre_test('ffpprb/ffgpfb'); 379ffgpfb($fptr,1,1,$npixels,$binarray,$larray,$anynull,$status); 380foreach (0..$#{$larray}) { $larray->[$_] and $binarray->[$_] = '*' } 381post_test(cmp_str_arrays($binarray,$standard) and $anynull == 1); 382 383pre_test('ffppri/ffgpfi'); 384ffgpfi($fptr,1,1,$npixels,$iinarray,$larray,$anynull,$status); 385foreach (0..$#{$larray}) { $larray->[$_] and $iinarray->[$_] = '*' } 386post_test(cmp_str_arrays($iinarray,$standard) and $anynull == 1); 387 388pre_test('ffpprj/ffgpfj'); 389ffgpfj($fptr,1,1,$npixels,$jinarray,$larray,$anynull,$status); 390foreach (0..$#{$larray}) { $larray->[$_] and $jinarray->[$_] = '*' } 391post_test(cmp_str_arrays($jinarray,$standard) and $anynull == 1); 392 393pre_test('ffppre/ffgpfe'); 394ffgpfe($fptr,1,1,$npixels,$einarray,$larray,$anynull,$status); 395foreach (0..$#{$larray}) { $larray->[$_] and $einarray->[$_] = '*' } 396post_test(cmp_str_arrays($einarray,$standard) and $anynull == 1); 397 398pre_test('ffpprd/ffgpfd'); 399ffgpfd($fptr,1,1,$npixels,$dinarray,$larray,$anynull,$status); 400foreach (0..$#{$larray}) { $larray->[$_] and $dinarray->[$_] = '*' } 401post_test(cmp_str_arrays($dinarray,$standard) and $anynull == 1); 402 403pre_test('ffclos/ffopen (10 times)'); 404my $ii; 405for ($ii=0;$ii<10;$ii++) { 406 ffclos($fptr,$status); 407 ffopen($fptr,$filename,READWRITE,$status); 408} 409post_test($status == 0); 410 411{ 412 # try assigning the filehandle elsewhere and seeing if it 413 # still works 414 pre_test("filehandle assign" ); 415 my $tfptr = $fptr; 416 $tfptr->file_name( my $fname, $status ); 417 post_test( $status == 0 and $fname eq $filename ); 418 419 # this should cause $fptr to indicate it has been closed. 420 pre_test( "filehandle assign close" ); 421 $tfptr->close_file( $status ); 422 post_test( $status == 0 and $fptr->_is_open == 0 ); 423 424 # reopen on fptr. this should not call DESTROY on anything, as 425 # tfptr should still point at the original file handle 426 pre_test( "filehandle assign pass" ); 427 ffopen($fptr,$filename,READWRITE,$status); 428 post_test( $status == 0 && $tfptr->_is_open == 0); 429 430 # now, assign $fptr to $tfptr (DESTROYING $tfptr) and let $tfptr go 431 # out of scope. this shouldn't destroy anything and thus shouldn't 432 # affect $fptr 433 pre_test( "filehandle assign" ); 434 $tfptr = $fptr; 435 post_test( $status == 0 && $tfptr->_is_open == 1); 436} 437 438# we should still be able to do this. 439pre_test("post assign DESTROY check"); 440$fptr->movabs_hdu(1,undef,$status); 441post_test( $status == 0 ); 442 443pre_test('PerlyUnpacking set'); 444PerlyUnpacking(0); 445post_test( PerlyUnpacking(-1) == PerlyUnpacking() && 446 PerlyUnpacking(-1) == 0 ); 447PerlyUnpacking(1); 448 449pre_test('fptr->perlyunpacking init'); 450post_test( $fptr->perlyunpacking == -1 ); 451 452pre_test('fptr->perlyunpacking == -1'); 453post_test( $fptr->PERLYUNPACKING == PerlyUnpacking() ); 454 455pre_test('fptr->perlyunpacking(0)'); 456$fptr->perlyunpacking(0); 457post_test( $fptr->perlyunpacking == 0 && $fptr->PERLYUNPACKING == 0 ); 458 459pre_test('fptr->perlyunpacking(1)'); 460$fptr->perlyunpacking(1); 461post_test( $fptr->perlyunpacking == 1 && $fptr->PERLYUNPACKING == 1 ); 462 463pre_test('fptr->perlyunpacking(-1)'); 464$fptr->perlyunpacking(-1); 465post_test( $fptr->perlyunpacking == -1 466 && $fptr->PERLYUNPACKING == PerlyUnpacking() ); 467 468 469pre_test('ffghdn'); 470post_test(ffghdn($fptr,$hdunum) == 1); 471 472pre_test('ffflnm'); 473ffflnm($fptr,$filename,$status); 474post_test($filename eq 'testprog.fit'); 475 476pre_test('ffflmd'); 477ffflmd($fptr,$filemode,$status); 478post_test(1 == $filemode); 479 480$simple = 0; 481$bitpix = 0; 482$naxis = 0; 483$naxes = [0,0]; 484$pcount = -99; 485$gcount = -99; 486$extend = -99; 487 488pre_test('ffghpr'); 489ffghpr($fptr,$simple,$bitpix,$naxis,$naxes,$pcount,$gcount,$extend,$status); 490post_test( 491 $status == 0 and 492 $simple == 1 and 493 $bitpix == 32 and 494 $naxis == 2 and 495 cmp_num_arrays($naxes,[10,2]) and 496 $pcount == 0 and 497 $gcount == 1 and 498 $extend == 1 499); 500 501pre_test('ffgrec'); 502ffgrec($fptr,9,$card,$status); 503post_test($card eq q!KEY_PREC= 'This keyword was written by fxprec' / comment goes here!); 504 505pre_test('ffgkyn'); 506my ($keyword,$value,$comment); 507ffgkyn($fptr,9,$keyword,$value,$comment,$status); 508post_test( 509 $keyword eq 'KEY_PREC' and 510 $value eq q/'This keyword was written by fxprec'/ and 511 $comment eq 'comment goes here' 512); 513 514pre_test('ffgcrd'); 515ffgcrd($fptr,$keyword,$card,$status); 516post_test($card eq q!KEY_PREC= 'This keyword was written by fxprec' / comment goes here!); 517 518pre_test('ffgkey'); 519ffgkey($fptr,'KY_PKNS1',$value,$comment,$status); 520post_test( $value eq q!'first string'! and $comment eq 'fxpkns comment'); 521 522pre_test('ffgkys'); 523my $iskey; 524ffgkys($fptr,'key_pkys',$iskey,$comment,$status); 525post_test($iskey eq 'value_string' and $comment eq 'fxpkys comment'); 526 527pre_test('ffgkyl'); 528my $ilkey; 529ffgkyl($fptr,'key_pkyl',$ilkey,$comment,$status); 530post_test($ilkey ==1 and $comment eq 'fxpkyl comment'); 531 532pre_test('ffgkyj'); 533my $ijkey; 534ffgkyj($fptr,'KEY_PKYJ',$ijkey,$comment,$status); 535post_test($ijkey == 11 and $comment eq 'fxpkyj comment'); 536 537pre_test('ffgkye'); 538my $iekey; 539ffgkye($fptr,'KEY_PKYJ',$iekey,$comment,$status); 540post_test($iekey == 11.0 and $comment eq 'fxpkyj comment'); 541 542pre_test('ffgkyd'); 543my $idkey; 544ffgkyd($fptr,'KEY_PKYJ',$idkey,$comment,$status); 545post_test($idkey == 11 and $comment eq 'fxpkyj comment'); 546 547$iskey = ''; 548pre_test('ffgky/TSTRING'); 549ffgky($fptr,TSTRING,'key_pkys',$iskey,$comment,$status); 550post_test($iskey eq 'value_string' and $comment eq 'fxpkys comment'); 551 552$ilkey = 0; 553pre_test('ffgky/TLOGICAL'); 554ffgky($fptr,TLOGICAL,'key_pkyl',$ilkey,$comment,$status); 555post_test($ilkey ==1 and $comment eq 'fxpkyl comment'); 556 557pre_test('ffgky/TBYTE'); 558ffgky($fptr,TBYTE,'key_pkyj',$cval,$comment,$status); 559post_test($cval==11 and $comment eq 'fxpkyj comment'); 560 561my $ishtkey; 562pre_test('ffgky/TSHORT'); 563ffgky($fptr,TSHORT,'key_pkyj',$ishtkey,$comment,$status); 564post_test($ishtkey ==11 and $comment eq 'fxpkyj comment'); 565 566pre_test('ffgky/TINT'); 567ffgky($fptr,TINT,'key_pkyj',$ilkey,$comment,$status); 568post_test($ilkey ==11 and $comment eq 'fxpkyj comment'); 569 570$ijkey=0; 571pre_test('ffgky/TLONG'); 572ffgky($fptr,TLONG,'KEY_PKYJ',$ijkey,$comment,$status); 573post_test($ijkey == 11 and $comment eq 'fxpkyj comment'); 574 575$iekey=0.0; 576pre_test('ffgky/TFLOAT'); 577ffgky($fptr,TFLOAT,'KEY_PKYE',$iekey,$comment,$status); 578post_test(sprintf("%f",$iekey) eq '13.131310' and $comment eq 'fxpkye comment'); 579 580$idkey=0.0; 581pre_test('ffgky/TDOUBLE'); 582ffgky($fptr,TDOUBLE,'KEY_PKYD',$idkey,$comment,$status); 583post_test(sprintf("%f",$idkey) eq '15.151515' and $comment eq 'fxpkyd comment'); 584 585pre_test('ffgkyd'); 586ffgkyd($fptr,'KEY_PKYF',$idkey,$comment,$status); 587post_test(sprintf("%f",$idkey) eq '12.121210' and $comment eq 'fxpkyf comment'); 588 589pre_test('ffgkyd'); 590ffgkyd($fptr,'KEY_PKYE',$idkey,$comment,$status); 591post_test(sprintf("%f",$idkey) eq '13.131310' and $comment eq 'fxpkye comment'); 592 593pre_test('ffgkyd'); 594ffgkyd($fptr,'KEY_PKYG',$idkey,$comment,$status); 595post_test(sprintf("%.14f",$idkey) eq '14.14141414141414' and $comment eq 'fxpkyg comment'); 596 597my ($inekey,$indkey); 598 599pre_test('ffgkyc'); 600ffgkyc($fptr,'KEY_PKYC',$inekey,$comment,$status); 601post_test( 602 sprintf("%f",$inekey->[0]) eq '13.131310' and 603 sprintf("%f",$inekey->[1]) eq '14.141410' and 604 $comment eq 'fxpkyc comment' 605); 606 607pre_test('ffgkyc'); 608ffgkyc($fptr,'KEY_PKFC',$inekey,$comment,$status); 609post_test( 610 sprintf("%f",$inekey->[0]) eq '13.131313' and 611 sprintf("%f",$inekey->[1]) eq '14.141414' and 612 $comment eq 'fxpkfc comment' 613); 614 615pre_test('ffgkym'); 616ffgkym($fptr,'KEY_PKYM',$indkey,$comment,$status); 617post_test( 618 sprintf("%f",$indkey->[0]) eq '15.151515' and 619 sprintf("%f",$indkey->[1]) eq '16.161616' and 620 $comment eq 'fxpkym comment' 621); 622 623pre_test('ffgkym'); 624ffgkym($fptr,'KEY_PKFM',$indkey,$comment,$status); 625post_test( 626 sprintf("%f",$indkey->[0]) eq '15.151515' and 627 sprintf("%f",$indkey->[1]) eq '16.161616' and 628 $comment eq 'fxpkfm comment' 629); 630 631pre_test('ffgkyt'); 632ffgkyt($fptr,'KEY_PKYT',$ijkey,$idkey,$comment,$status); 633post_test( 634 $ijkey == 12345678 and 635 sprintf("%.14f",$idkey) eq '0.12345678901235' and 636 $comment eq 'fxpkyt comment' 637); 638 639pre_test('ffpunt/ffgunt'); 640ffpunt($fptr,'KEY_PKYJ','km/s/Mpc',$status); 641ffgunt($fptr,'KEY_PKYJ',$comment,$status); 642post_test($comment eq 'km/s/Mpc'); 643 644pre_test('ffpunt/ffgunt'); 645ffpunt($fptr,'KEY_PKYJ','',$status); 646ffgunt($fptr,'KEY_PKYJ',$comment,$status); 647post_test($comment eq ''); 648 649pre_test('ffpunt/ffgunt'); 650ffpunt($fptr,'KEY_PKYJ','feet/second/second',$status); 651ffgunt($fptr,'KEY_PKYJ',$comment,$status); 652post_test($comment eq 'feet/second/second'); 653 654my $lsptr; 655pre_test('ffgkls'); 656ffgkls($fptr,'key_pkls',$lsptr,$comment,$status); 657post_test($lsptr eq q!This is a very long string value that is continued over more than one keyword.!); 658 659pre_test('ffgkns'); 660my ($nfound,$inskey); 661ffgkns($fptr,'ky_pkns',1,3,$inskey,$nfound,$status); 662post_test( 663 $nfound == 3 and 664 cmp_str_arrays($inskey,[ 'first string', 'second string', '']) 665); 666 667pre_test('ffgknl'); 668my $inlkey; 669ffgknl($fptr,'ky_pknl',1,3,$inlkey,$nfound,$status); 670post_test( 671 $nfound == 3 and 672 cmp_num_arrays($inlkey,[1,0,1]) 673); 674 675pre_test('ffgknj'); 676my $injkey; 677ffgknj($fptr,'ky_pknj',1,3,$injkey,$nfound,$status); 678post_test( 679 $nfound == 3 and 680 cmp_num_arrays($injkey,[11,12,13]) 681); 682 683pre_test('ffgkne'); 684ffgkne($fptr,'ky_pkne',1,3,$inekey,$nfound,$status); 685post_test( 686 $nfound == 3 and 687 sprintf("%f",$inekey->[0]) eq '13.131310' and 688 sprintf("%f",$inekey->[1]) eq '14.141410' and 689 sprintf("%f",$inekey->[2]) eq '15.151520' 690); 691 692pre_test('ffgknd'); 693ffgknd($fptr,'ky_pknd',1,3,$indkey,$nfound,$status); 694post_test( 695 $nfound == 3 and 696 sprintf("%f",$indkey->[0]) eq '15.151515' and 697 sprintf("%f",$indkey->[1]) eq '16.161616' and 698 sprintf("%f",$indkey->[2]) eq '17.171717' 699); 700 701pre_test('ffgcrd/ffghps/ffgrec'); 702my ($existkeys,$keynum); 703ffgcrd($fptr,'HISTORY',$card,$status); 704ffghps($fptr,$existkeys,$keynum,$status); 705$keynum -= 2; 706my @tmp; 707for ($ii=$keynum; $ii<=$keynum+3;$ii++) { 708 ffgrec($fptr,$ii,$card,$status); 709 push @tmp, substr($card,0,8); 710} 711post_test( 712 cmp_str_arrays(\@tmp,['COMMENT ','HISTORY ','DATE ','KY_PKNS1'] ) 713); 714 715pre_test('ffdrec/ffdkey'); 716@tmp = (); 717ffdrec($fptr,$keynum+1,$status); 718ffdkey($fptr,'DATE',$status); 719for ($ii=$keynum; $ii<=$keynum+1;$ii++) { 720 ffgrec($fptr,$ii,$card,$status); 721 push @tmp,$card; 722} 723post_test( 724 cmp_str_arrays( 725 \@tmp, 726 [ 727 q!COMMENT This keyword was written by fxpcom.!, 728 q!KY_PKNS1= 'first string' / fxpkns comment! 729 ] 730 ) and $status == 0 731); 732 733pre_test('ffirec/ffikyX'); 734$keynum += 4; 735ffirec($fptr,$keynum-3,"KY_IREC = 'This keyword inserted by fxirec'",$status); 736ffikys($fptr,'KY_IKYS',"insert_value_string", "ikys comment", $status); 737ffikyj($fptr,'KY_IKYJ',49,"ikyj comment", $status); 738ffikyl($fptr,'KY_IKYL',1, "ikyl comment", $status); 739ffikye($fptr,'KY_IKYE',12.3456, 4, "ikye comment", $status); 740ffikyd($fptr,'KY_IKYD',12.345678901234567, 14, "ikyd comment", $status); 741ffikyf($fptr,'KY_IKYF',12.3456, 4, "ikyf comment", $status); 742ffikyg($fptr,'KY_IKYG',12.345678901234567, 13, "ikyg comment", $status); 743@tmp = (); 744for ($ii=$keynum-4; $ii<=$keynum+5;$ii++) { 745 ffgrec($fptr,$ii,$card,$status); 746 push @tmp, $card; 747} 748post_test( 749 cmp_str_arrays( 750 \@tmp, 751 [ 752 q!COMMENT This keyword was written by fxpcom.!, 753 q!KY_IREC = 'This keyword inserted by fxirec'!, 754 q!KY_IKYS = 'insert_value_string' / ikys comment!, 755 q!KY_IKYJ = 49 / ikyj comment!, 756 q!KY_IKYL = T / ikyl comment!, 757 q!KY_IKYE = 1.2346E+01 / ikye comment!, 758 q!KY_IKYD = 1.23456789012346E+01 / ikyd comment!, 759 q!KY_IKYF = 12.3456 / ikyf comment!, 760 q!KY_IKYG = 12.3456789012346 / ikyg comment!, 761 q!KY_PKNS1= 'first string' / fxpkns comment! 762 ] 763 ) and $status == 0 764); 765 766pre_test('ffmrec/ffmcrd/ffmnam/ffmcom/ffmkyX'); 767ffmrec($fptr,$keynum-4,'COMMENT This keyword was modified by fxmrec', $status); 768ffmcrd($fptr,'KY_IREC',"KY_MREC = 'This keyword was modified by fxmcrd'",$status); 769ffmnam($fptr,'KY_IKYS','NEWIKYS',$status); 770ffmcom($fptr,'KY_IKYJ','This is a modified comment', $status); 771ffmkyj($fptr,'KY_IKYJ',50,'&',$status); 772ffmkyl($fptr,'KY_IKYL',0,'&',$status); 773ffmkys($fptr,'NEWIKYS','modified_string', '&', $status); 774ffmkye($fptr,'KY_IKYE',-12.3456, 4, '&', $status); 775ffmkyd($fptr,'KY_IKYD',-12.345678901234567, 14, 'modified comment', $status); 776ffmkyf($fptr,'KY_IKYF',-12.3456, 4, '&', $status); 777ffmkyg($fptr,'KY_IKYG',-12.345678901234567, 13, '&', $status); 778@tmp = (); 779for ($ii=$keynum-4; $ii<=$keynum+5;$ii++) { 780 ffgrec($fptr,$ii,$card,$status); 781 push @tmp, $card; 782} 783post_test( 784 cmp_str_arrays( 785 \@tmp, 786 [ 787 q!COMMENT This keyword was modified by fxmrec!, 788 q!KY_MREC = 'This keyword was modified by fxmcrd'!, 789 q!NEWIKYS = 'modified_string' / ikys comment!, 790 q!KY_IKYJ = 50 / This is a modified comment!, 791 q!KY_IKYL = F / ikyl comment!, 792 q!KY_IKYE = -1.2346E+01 / ikye comment!, 793 q!KY_IKYD = -1.23456789012346E+01 / modified comment!, 794 q!KY_IKYF = -12.3456 / ikyf comment!, 795 q!KY_IKYG = -12.3456789012346 / ikyg comment!, 796 q!KY_PKNS1= 'first string' / fxpkns comment!, 797 ] 798 ) and $status == 0 799); 800 801pre_test('ffucrd/ffukyX'); 802ffucrd($fptr,'KY_MREC',"KY_UCRD = 'This keyword was updated by fxucrd'",$status); 803ffukyj($fptr,'KY_IKYJ',51,'&',$status); 804ffukyl($fptr,'KY_IKYL',1,'&',$status); 805ffukys($fptr,'NEWIKYS',"updated_string",'&',$status); 806ffukye($fptr,'KY_IKYE',-13.3456, 4,'&',$status); 807ffukyd($fptr,'KY_IKYD',-13.345678901234567, 14,'modified comment',$status); 808ffukyf($fptr,'KY_IKYF',-13.3456, 4,'&',$status); 809ffukyg($fptr,'KY_IKYG',-13.345678901234567, 13,'&',$status); 810@tmp=(); 811for ($ii=$keynum-4; $ii<=$keynum+5;$ii++) { 812 ffgrec($fptr,$ii,$card,$status); 813 push @tmp,$card; 814} 815post_test( 816 cmp_str_arrays( 817 \@tmp, 818 [ 819 q!COMMENT This keyword was modified by fxmrec!, 820 q!KY_UCRD = 'This keyword was updated by fxucrd'!, 821 q!NEWIKYS = 'updated_string' / ikys comment!, 822 q!KY_IKYJ = 51 / This is a modified comment!, 823 q!KY_IKYL = T / ikyl comment!, 824 q!KY_IKYE = -1.3346E+01 / ikye comment!, 825 q!KY_IKYD = -1.33456789012346E+01 / modified comment!, 826 q!KY_IKYF = -13.3456 / ikyf comment!, 827 q!KY_IKYG = -13.3456789012346 / ikyg comment!, 828 q!KY_PKNS1= 'first string' / fxpkns comment!, 829 ] 830 ) and $status == 0 831); 832 833 834pre_test('ffgnxk'); 835ffgrec($fptr,0,$card,$status); 836$nfound = 0; 837@tmp = (); 838my $inclist = [ 'key*', 'newikys' ]; 839my $exclist = [ 'key_pr*', 'key_pkls' ]; 840while (!ffgnxk($fptr,$inclist,2,$exclist,2,$card,$status)) { 841 $nfound++; 842 push @tmp, $card; 843} 844post_test( 845 $nfound == 13 and 846 cmp_str_arrays( 847 \@tmp, 848 [ 849 q!KEY_PKYS= 'value_string' / fxpkys comment!, 850 q!KEY_PKYL= T / fxpkyl comment!, 851 q!KEY_PKYJ= 11 / [feet/second/second] fxpkyj comment!, 852 q!KEY_PKYF= 12.12121 / fxpkyf comment!, 853 q!KEY_PKYE= 1.313131E+01 / fxpkye comment!, 854 q!KEY_PKYG= 14.14141414141414 / fxpkyg comment!, 855 q!KEY_PKYD= 1.51515151515152E+01 / fxpkyd comment!, 856 q!KEY_PKYC= (1.313131E+01, 1.414141E+01) / fxpkyc comment!, 857 q!KEY_PKYM= (1.51515151515152E+01, 1.61616161616162E+01) / fxpkym comment!, 858 q!KEY_PKFC= (13.131313, 14.141414) / fxpkfc comment!, 859 q!KEY_PKFM= (15.15151515151515, 16.16161616161616) / fxpkfm comment!, 860 q!KEY_PKYT= 12345678.1234567890123456 / fxpkyt comment!, 861 q!NEWIKYS = 'updated_string' / ikys comment!, 862 ] 863 ) 864); 865$status = 0; 866 867pre_test('ffcpky'); 868ffcpky($fptr,$fptr,1,4,'KY_PKNE',$status); 869ffgkns($fptr,'ky_pkne',2,4,$inekey,$nfound,$status); 870post_test( 871 $status == 0 and 872 sprintf("%f %f %f",@$inekey) eq '14.141410 15.151520 13.131310' 873); 874 875pre_test('ffpktp'); 876post_test( ffpktp($fptr,$template,$status) == 0); 877 878my $tform = [ qw( 15A 1L 16X 1B 1I 1J 1E 1D 1C 1M ) ]; 879my $ttype = [ qw( Avalue Lvalue Xvalue Bvalue Ivalue Jvalue Evalue Dvalue Cvalue Mvalue ) ]; 880my $tunit = [ ( '', 'm**2', 'cm', 'erg/s', 'km/s', '', '', '', '', '') ]; 881 882my $nrows = 21; 883my $tfields = 10; 884$pcount = 0; 885 886my $binname = 'Test-BINTABLE'; 887pre_test('ffibin'); 888post_test( 889 ffibin($fptr,$nrows,$tfields,$ttype,$tform,$tunit,$binname,0,$status) == 0 and 890 ffghdn($fptr,$hdunum) == 2 891); 892 893pre_test('ffghps'); 894ffghps($fptr,$existkeys,$keynum,$status); 895post_test( $existkeys == 33 and $keynum == 1); 896 897pre_test('ffhdef/ffghsp'); 898my $morekeys=40; 899ffhdef($fptr,$morekeys,$status); 900ffghsp($fptr,$existkeys,$morekeys,$status); 901post_test( $existkeys == 33 and $morekeys == 74 ); 902 903fftnul($fptr,4,99,$status); 904fftnul($fptr,5,99,$status); 905fftnul($fptr,6,99,$status); 906 907my $extvers=1; 908ffpkyj($fptr,'EXTVER',$extvers,'extension version number', $status); 909ffpkyj($fptr,'TNULL4',99,'value for undefined pixels',$status); 910ffpkyj($fptr,'TNULL5',99,'value for undefined pixels',$status); 911ffpkyj($fptr,'TNULL6',99,'value for undefined pixels',$status); 912 913pre_test('ffptdm/ffgtdm'); 914$naxis=3; 915$naxes=[1,2,8]; 916ffptdm($fptr,3,$naxis,$naxes,$status); 917$naxis=0; 918$naxes=undef; 919ffgtdm($fptr,3,$naxis,$naxes,$status); 920ffgkys($fptr,'TDIM3',$iskey,$comment,$status); 921post_test( 922 $iskey eq '(1,2,8)' and 923 $naxis = 3 and 924 cmp_num_arrays($naxes,[1,2,8]) 925); 926 927ffrdef($fptr,$status); 928 929my $signval = -1; 930my $koutarray; 931for ($ii=0;$ii<21;$ii++) { 932 $signval *= -1; 933 $boutarray->[$ii] = ($ii + 1); 934 $ioutarray->[$ii] = ($ii + 1) * $signval; 935 $joutarray->[$ii] = ($ii + 1) * $signval; 936 $koutarray->[$ii] = ($ii + 1) * $signval; 937 $eoutarray->[$ii] = ($ii + 1) * $signval; 938 $doutarray->[$ii] = ($ii + 1) * $signval; 939} 940 941pre_test('ffpclX/ffpcnX'); 942ffpcls($fptr,1,1,1,3,$onskey,$status); 943ffpclu($fptr,1,4,1,1,$status); 944 945$larray = [0,1,0,0,1,1,0,0,0,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0]; 946ffpclx($fptr,3,1,1,36,$larray,$status); 947 948for ($ii=4;$ii<9;$ii++) { 949 ffpclb($fptr,$ii,1,1,2,$boutarray,$status); 950 ($status == NUM_OVERFLOW) and $status = 0; 951 ffpcli($fptr,$ii,3,1,2,[@{$ioutarray}[2..3]],$status); 952 ($status == NUM_OVERFLOW) and $status = 0; 953 ffpclk($fptr,$ii,5,1,2,[@{$koutarray}[4..5]],$status); 954 ($status == NUM_OVERFLOW) and $status = 0; 955 ffpcle($fptr,$ii,7,1,2,[@{$eoutarray}[6..7]],$status); 956 ffpcld($fptr,$ii,9,1,2,[@{$doutarray}[8..9]],$status); 957 ($status == NUM_OVERFLOW) and $status = 0; 958 ffpclu($fptr,$ii,11,1,1,$status); 959} 960 961ffpclc($fptr,9,1,1,10,$eoutarray,$status); 962ffpclm($fptr,10,1,1,10,$doutarray,$status); 963 964for ($ii=4;$ii<9;$ii++) { 965 ffpcnb($fptr,$ii,12,1,2,[@{$boutarray}[11..12]],13,$status); 966 ($status == NUM_OVERFLOW) and $status = 0; 967 ffpcni($fptr,$ii,14,1,2,[@{$ioutarray}[13..14]],15,$status); 968 ($status == NUM_OVERFLOW) and $status = 0; 969 ffpcnk($fptr,$ii,16,1,2,[@{$koutarray}[15..16]],17,$status); 970 ($status == NUM_OVERFLOW) and $status = 0; 971 ffpcne($fptr,$ii,18,1,2,[@{$eoutarray}[17..18]],19.,$status); 972 ($status == NUM_OVERFLOW) and $status = 0; 973 ffpcnd($fptr,$ii,20,1,2,[@{$doutarray}[19..20]],21.,$status); 974 ($status == NUM_OVERFLOW) and $status = 0; 975} 976ffpcll($fptr,2,1,1,21,$larray,$status); 977ffpclu($fptr,2,11,1,1,$status); 978 979post_test($status == 0); 980 981pre_test('ffgcno/ffgcnn'); 982my (@tmp1,@tmp2,@tmp3); 983my ($colnum,$colname); 984ffgcno($fptr,0,'Xvalue',$colnum,$status); 985push @tmp1, $colnum; 986push @tmp2, $status; 987push @tmp3, 'Xvalue'; 988while ($status != COL_NOT_FOUND) { 989 ffgcnn($fptr,1,'*ue',$colname,$colnum,$status); 990 push @tmp1, $colnum; 991 push @tmp2, $status; 992 push @tmp3, $colname; 993} 994post_test( 995 cmp_num_arrays(\@tmp1,[3,1,2,3,4,5,6,7,8,9,10,0]) and 996 cmp_num_arrays(\@tmp2,[0,237,237,237,237,237,237,237,237,237,237,219]) and 997 cmp_str_arrays(\@tmp3,['Xvalue','Avalue','Lvalue','Xvalue','Bvalue','Ivalue','Jvalue','Evalue','Dvalue','Cvalue','Mvalue','']) 998); 999$status = 0; 1000 1001pre_test('ffgtcl/ffgbcl'); 1002@tmp1 = @tmp2 = @tmp3 = (); 1003my (@tmp4,@tmp5,@tmp6,@tmp7,@tmp8,@tmp9,@tmp10,@tmp11); 1004my ($typecode,$repeat,$width,$scale,$zero,$jnulval,$tdisp); 1005for ($ii=0;$ii<$tfields;$ii++) { 1006 ffgtcl($fptr,$ii+1,$typecode,$repeat,$width,$status); 1007 ffgbcl($fptr,$ii+1,$ttype->[0],$tunit->[0],$cval,$repeat,$scale,$zero,$jnulval,$tdisp,$status); 1008 1009 push @tmp1,$typecode; 1010 push @tmp2,$repeat; 1011 push @tmp3,$width; 1012 push @tmp4,$ttype->[0]; 1013 push @tmp5,$tunit->[0]; 1014 push @tmp6,$cval; 1015 push @tmp7,$repeat; 1016 push @tmp8,$scale; 1017 push @tmp9,$zero; 1018 push @tmp10,$jnulval; 1019 push @tmp11,$tdisp; 1020} 1021 1022post_test( 1023 cmp_num_arrays(\@tmp1,[16,14,1,11,21,41,42,82,83,163]) and 1024 cmp_num_arrays(\@tmp2,[15,1,16,1,1,1,1,1,1,1]) and 1025 cmp_num_arrays(\@tmp3,[15,1,1,1,2,4,4,8,8,16]) and 1026 cmp_str_arrays(\@tmp4,[qw( Avalue Lvalue Xvalue Bvalue Ivalue Jvalue Evalue Dvalue Cvalue Mvalue )]) and 1027 cmp_str_arrays(\@tmp5,['','m**2','cm','erg/s','km/s','','','','','']) and 1028 cmp_str_arrays(\@tmp6,[qw( A L X B I J E D C M )]) and 1029 cmp_num_arrays(\@tmp7,[15,1,16,1,1,1,1,1,1,1]) and 1030 cmp_num_arrays(\@tmp8,[map(1.0,(0..$tfields-1))]) and 1031 cmp_num_arrays(\@tmp9,[map(0.0,(0..$tfields-1))]) and 1032 cmp_num_arrays(\@tmp10,[1234554321,1234554321,1234554321,99,99,99,1234554321,1234554321,1234554321,1234554321]) and 1033 cmp_str_arrays(\@tmp11,[map('',(0..$tfields-1))]) 1034); 1035 1036pre_test('ffmrhd'); 1037post_test(ffmrhd($fptr,-1,undef,$status) == 0); 1038 1039$tform = [ qw( A15 I10 F14.6 E12.5 D21.14 ) ]; 1040$ttype = [ qw( Name Ivalue Fvalue Evalue Dvalue ) ]; 1041$tunit = [ ('','m**2','cm','erg/s','km/s') ]; 1042my $rowlen = 76; 1043$nrows = 11; 1044$tfields = 5; 1045 1046pre_test('ffitab'); 1047my $tblname = 'Test-ASCII'; 1048my $tbcol = [1,17,28,43,56]; 1049ffitab($fptr,$rowlen,$nrows,$tfields,$ttype,$tbcol,$tform,$tunit,$tblname,$status); 1050post_test($status == 0 and ffghdn($fptr,$hdunum) == 2); 1051 1052 1053pre_test('ffsnul/ffpkyj'); 1054ffsnul($fptr,1,'null1',$status); 1055ffsnul($fptr,2,'null2',$status); 1056ffsnul($fptr,3,'null3',$status); 1057ffsnul($fptr,4,'null4',$status); 1058ffsnul($fptr,5,'null5',$status); 1059 1060$extvers=2; 1061ffpkyj($fptr,'EXTVER',$extvers,'extension version number',$status); 1062ffpkys($fptr,'TNULL1','null1','value for undefined pixels',$status); 1063ffpkys($fptr,'TNULL2','null2','value for undefined pixels',$status); 1064ffpkys($fptr,'TNULL3','null3','value for undefined pixels',$status); 1065ffpkys($fptr,'TNULL4','null4','value for undefined pixels',$status); 1066ffpkys($fptr,'TNULL5','null5','value for undefined pixels',$status); 1067post_test($status == 0); 1068 1069for ($ii=0;$ii<21;$ii++) { 1070 $boutarray->[$ii] = $ii+1; 1071 $ioutarray->[$ii] = $ii+1; 1072 $joutarray->[$ii] = $ii+1; 1073 $eoutarray->[$ii] = $ii+1; 1074 $doutarray->[$ii] = $ii+1; 1075} 1076 1077pre_test('ffpclX'); 1078ffpcls($fptr,1,1,1,3,$onskey,$status); 1079ffpclu($fptr,1,4,1,1,$status); 1080 1081for ($ii=2;$ii<6;$ii++) { 1082 ffpclb($fptr,$ii,1,1,2,[@{$boutarray}[0..1]],$status); 1083 ($status == NUM_OVERFLOW) and $status = 0; 1084 ffpcli($fptr,$ii,3,1,2,[@{$ioutarray}[2..3]],$status); 1085 ($status == NUM_OVERFLOW) and $status = 0; 1086 ffpclj($fptr,$ii,5,1,2,[@{$joutarray}[4..5]],$status); 1087 ($status == NUM_OVERFLOW) and $status = 0; 1088 ffpcle($fptr,$ii,7,1,2,[@{$eoutarray}[6..7]],$status); 1089 ($status == NUM_OVERFLOW) and $status = 0; 1090 ffpcld($fptr,$ii,9,1,2,[@{$doutarray}[8..9]],$status); 1091 ($status == NUM_OVERFLOW) and $status = 0; 1092 1093 ffpclu($fptr,$ii,11,1,1,$status); 1094} 1095post_test($status == 0); 1096 1097pre_test('ffghtb'); 1098my $extname; 1099ffghtb($fptr,$rowlen,$nrows,$tfields,$ttype,$tbcol,$tform,$tunit,$tblname,$status); 1100post_test( 1101 $rowlen == 76 and $nrows == 11 and $tfields == 5 and $tblname eq 'Test-ASCII' and 1102 cmp_str_arrays($ttype,[qw( Name Ivalue Fvalue Evalue Dvalue )]) and 1103 cmp_num_arrays($tbcol,[1,17,28,43,56]) and 1104 cmp_str_arrays($tform,[qw( A15 I10 F14.6 E12.5 D21.14 )]) 1105); 1106 1107$nrows=11; 1108pre_test('ffgcvX'); 1109$inskey = $binarray = $iinarray = $jinarray = $einarray = $dinarray = undef; 1110ffgcvs($fptr,1,1,1,$nrows,'UNDEFINED',$inskey,$anynull,$status); 1111ffgcvb($fptr,2,1,1,$nrows,99,$binarray,$anynull,$status); 1112ffgcvi($fptr,2,1,1,$nrows,99,$iinarray,$anynull,$status); 1113ffgcvj($fptr,3,1,1,$nrows,99,$jinarray,$anynull,$status); 1114ffgcve($fptr,4,1,1,$nrows,99,$einarray,$anynull,$status); 1115ffgcvd($fptr,5,1,1,$nrows,99,$dinarray,$anynull,$status); 1116post_test( 1117 cmp_str_arrays($inskey,['first string','second string',' ','UNDEFINED',' ',' ',' ',' ',' ',' ',' ']) and 1118 cmp_num_arrays($binarray,[1..10,99]) and 1119 cmp_num_arrays($iinarray,[1..10,99]) and 1120 cmp_num_arrays($jinarray,[1..10,99]) and 1121 cmp_num_arrays($einarray,[1..10,99]) and 1122 cmp_num_arrays($dinarray,[1..10,99]) 1123); 1124 1125pre_test('ffgtbb'); 1126my $uchars; 1127ffgtbb($fptr,1,20,78,$uchars,$status); 1128ffptbb($fptr,1,20,78,$uchars,$status); 1129post_test( 1130 pack("C78",@$uchars) eq q! 1 1.000000 1.00000E+00 1.00000000000000E+00second string ! 1131); 1132 1133pre_test('ffgcno/ffgcnn'); 1134@tmp1=@tmp2=@tmp3=(); 1135ffgcno($fptr,0,'name',$colnum,$status); 1136push @tmp1, 'name'; 1137push @tmp2, $colnum; 1138push @tmp3, $status; 1139while ($status != COL_NOT_FOUND) { 1140 ffgcnn($fptr,0,'*ue',$colname,$colnum,$status); 1141 push @tmp1, $colname; 1142 push @tmp2, $colnum; 1143 push @tmp3, $status; 1144} 1145$status = 0; 1146post_test( 1147 cmp_str_arrays(\@tmp1,['name', 'Ivalue', 'Fvalue', 'Evalue', 'Dvalue','']) and 1148 cmp_num_arrays(\@tmp2,[1,2,3,4,5,0]) and 1149 cmp_num_arrays(\@tmp3,[0,237,237,237,237,219]) 1150); 1151 1152pre_test('ffgtcl/ffgacl'); 1153my $nulstr; 1154@tmp1=@tmp2=@tmp3=@tmp4=@tmp5=@tmp6=@tmp7=@tmp8=@tmp9=@tmp10=@tmp11=(); 1155for ($ii=0;$ii<$tfields;$ii++) { 1156 ffgtcl($fptr,$ii+1,$typecode,$repeat,$width,$status); 1157 ffgacl($fptr,$ii+1,$ttype->[0],$tbcol,$tunit->[0],$tform->[0],$scale,$zero,$nulstr,$tdisp,$status); 1158 push @tmp1,$typecode; 1159 push @tmp2,$repeat; 1160 push @tmp3,$width; 1161 push @tmp4,$ttype->[0]; 1162 push @tmp5,$tbcol; 1163 push @tmp6,$tunit->[0]; 1164 push @tmp7,$tform->[0]; 1165 push @tmp8,$scale; 1166 push @tmp9,$zero; 1167 push @tmp10,$nulstr; 1168 push @tmp11,$tdisp; 1169} 1170post_test( 1171 cmp_num_arrays(\@tmp1,[16,41,82,42,82]) and 1172 cmp_num_arrays(\@tmp2,[1,1,1,1,1]) and 1173 cmp_num_arrays(\@tmp3,[15,10,14,12,21]) and 1174 cmp_str_arrays(\@tmp4,[qw( Name Ivalue Fvalue Evalue Dvalue )]) and 1175 cmp_num_arrays(\@tmp5,[1,17,28,43,56]) and 1176 cmp_str_arrays(\@tmp6,['','m**2','cm','erg/s','km/s']) and 1177 cmp_str_arrays(\@tmp7,[qw( A15 I10 F14.6 E12.5 D21.14 )]) and 1178 cmp_num_arrays(\@tmp8,[map(1.0,(0..$tfields-1))]) and 1179 cmp_num_arrays(\@tmp9,[map(0.0,(0..$tfields-1))]) and 1180 cmp_str_arrays(\@tmp10,[map('null'.$_,(1..$tfields))]) and 1181 cmp_str_arrays(\@tmp11,[map('',(0..$tfields-1))]) 1182); 1183 1184pre_test('ffirow'); 1185ffirow($fptr,2,3,$status); 1186 1187$nrows=14; 1188 1189$inskey=$binarray=$iinarray=$jinarray=$einarray=$dinarray=undef; 1190ffgcvs($fptr,1,1,1,$nrows,'UNDEFINED',$inskey,$anynull,$status); 1191ffgcvb($fptr,2,1,1,$nrows,99,$binarray,$anynull,$status); 1192ffgcvi($fptr,2,1,1,$nrows,99,$iinarray,$anynull,$status); 1193ffgcvj($fptr,3,1,1,$nrows,99,$jinarray,$anynull,$status); 1194ffgcve($fptr,4,1,1,$nrows,99,$einarray,$anynull,$status); 1195ffgcvd($fptr,5,1,1,$nrows,99,$dinarray,$anynull,$status); 1196 1197post_test( 1198 cmp_str_arrays($inskey,['first string','second string',' ',' ',' ',' ','UNDEFINED',map(' ',(0..6))]) and 1199 cmp_num_arrays($binarray,[1,2,0,0,0,3..10,99]) and 1200 cmp_num_arrays($iinarray,[1,2,0,0,0,3..10,99]) and 1201 cmp_num_arrays($jinarray,[1,2,0,0,0,3..10,99]) and 1202 cmp_num_arrays($einarray,[1,2,0,0,0,3..10,99]) and 1203 cmp_num_arrays($dinarray,[1,2,0,0,0,3..10,99]) 1204); 1205 1206pre_test('ffdrow'); 1207ffdrow($fptr,10,2,$status); 1208$nrows=12; 1209 1210$inskey=$binarray=$iinarray=$jinarray=$einarray=$dinarray=undef; 1211ffgcvs($fptr,1,1,1,$nrows,'UNDEFINED',$inskey,$anynull,$status); 1212ffgcvb($fptr,2,1,1,$nrows,99,$binarray,$anynull,$status); 1213ffgcvi($fptr,2,1,1,$nrows,99,$iinarray,$anynull,$status); 1214ffgcvj($fptr,3,1,1,$nrows,99,$jinarray,$anynull,$status); 1215ffgcve($fptr,4,1,1,$nrows,99,$einarray,$anynull,$status); 1216ffgcvd($fptr,5,1,1,$nrows,99,$dinarray,$anynull,$status); 1217 1218post_test( 1219 cmp_str_arrays($inskey,['first string','second string',' ',' ',' ',' ','UNDEFINED',map(' ',(0..4))]) and 1220 cmp_num_arrays($binarray,[1,2,0,0,0,3..6,9..10,99]) and 1221 cmp_num_arrays($iinarray,[1,2,0,0,0,3..6,9..10,99]) and 1222 cmp_num_arrays($jinarray,[1,2,0,0,0,3..6,9..10,99]) and 1223 cmp_num_arrays($einarray,[1,2,0,0,0,3..6,9..10,99]) and 1224 cmp_num_arrays($dinarray,[1,2,0,0,0,3..6,9..10,99]) 1225); 1226 1227pre_test('ffdcol'); 1228ffdcol($fptr,3,$status); 1229 1230$inskey=$binarray=$iinarray=$jinarray=$einarray=$dinarray=undef; 1231ffgcvs($fptr,1,1,1,$nrows,'UNDEFINED',$inskey,$anynull,$status); 1232ffgcvb($fptr,2,1,1,$nrows,99,$binarray,$anynull,$status); 1233ffgcvi($fptr,2,1,1,$nrows,99,$iinarray,$anynull,$status); 1234ffgcve($fptr,3,1,1,$nrows,99,$einarray,$anynull,$status); 1235ffgcvd($fptr,4,1,1,$nrows,99,$dinarray,$anynull,$status); 1236 1237post_test( 1238 cmp_str_arrays($inskey,['first string','second string',' ',' ',' ',' ','UNDEFINED',map(' ',(0..4))]) and 1239 cmp_num_arrays($binarray,[1,2,0,0,0,3..6,9..10,99]) and 1240 cmp_num_arrays($iinarray,[1,2,0,0,0,3..6,9..10,99]) and 1241 cmp_num_arrays($einarray,[1,2,0,0,0,3..6,9..10,99]) and 1242 cmp_num_arrays($dinarray,[1,2,0,0,0,3..6,9..10,99]) 1243); 1244 1245pre_test('fficol'); 1246fficol($fptr,5,'INSERT_COL','F14.6',$status); 1247 1248$inskey=$binarray=$iinarray=$jinarray=$einarray=$dinarray=undef; 1249ffgcvs($fptr,1,1,1,$nrows,'UNDEFINED',$inskey,$anynull,$status); 1250ffgcvb($fptr,2,1,1,$nrows,99,$binarray,$anynull,$status); 1251ffgcvi($fptr,2,1,1,$nrows,99,$iinarray,$anynull,$status); 1252ffgcve($fptr,3,1,1,$nrows,99,$einarray,$anynull,$status); 1253ffgcvd($fptr,4,1,1,$nrows,99,$dinarray,$anynull,$status); 1254ffgcvj($fptr,5,1,1,$nrows,99,$jinarray,$anynull,$status); 1255 1256post_test( 1257 cmp_str_arrays($inskey,['first string','second string',' ',' ',' ',' ','UNDEFINED',map(' ',(0..4))]) and 1258 cmp_num_arrays($binarray,[1,2,0,0,0,3..6,9..10,99]) and 1259 cmp_num_arrays($iinarray,[1,2,0,0,0,3..6,9..10,99]) and 1260 cmp_num_arrays($einarray,[1,2,0,0,0,3..6,9..10,99]) and 1261 cmp_num_arrays($dinarray,[1,2,0,0,0,3..6,9..10,99]) and 1262 cmp_num_arrays($jinarray,[map(0,(0..$nrows-1))]) 1263); 1264 1265 1266$bitpix=16; 1267$naxis=0; 1268$filename = '!t1q2s3v6.tmp'; 1269 1270pre_test('ffinit'); 1271my $tmpfptr; 1272post_test(ffinit($tmpfptr,$filename,$status) == 0); 1273 1274pre_test('ffiimg'); 1275post_test(ffiimg($tmpfptr,$bitpix,$naxis,$naxes,$status) == 0); 1276 1277$nrows=12; 1278$tfields=0; 1279$rowlen=0; 1280 1281pre_test('ffitab'); 1282ffitab($tmpfptr,$rowlen,$nrows,$tfields,$ttype,$tbcol,$tform,$tunit,$tblname,$status); 1283post_test($status == 0); 1284 1285pre_test('ffcpcl'); 1286ffcpcl($fptr,$tmpfptr,4,1,TRUE,$status); 1287ffcpcl($fptr,$tmpfptr,3,1,TRUE,$status); 1288ffcpcl($fptr,$tmpfptr,2,1,TRUE,$status); 1289ffcpcl($fptr,$tmpfptr,1,1,TRUE,$status); 1290post_test($status == 0); 1291 1292pre_test('ffibin'); 1293ffibin($tmpfptr,$nrows,$tfields,$ttype,$tform,$tunit,$tblname,0,$status); 1294post_test($status == 0); 1295 1296pre_test('ffcpcl'); 1297ffcpcl($fptr,$tmpfptr,4,1,TRUE,$status); 1298ffcpcl($fptr,$tmpfptr,3,1,TRUE,$status); 1299ffcpcl($fptr,$tmpfptr,2,1,TRUE,$status); 1300ffcpcl($fptr,$tmpfptr,1,1,TRUE,$status); 1301post_test($status == 0); 1302 1303pre_test('ffdelt'); 1304ffdelt($tmpfptr,$status); 1305post_test($status == 0); 1306 1307pre_test('ffmrhd'); 1308ffmrhd($fptr,1,undef,$status); 1309post_test($status == 0 and ffghdn($fptr,$hdunum) == 3); 1310 1311pre_test('ffghsp'); 1312ffghsp($fptr,$existkeys,$morekeys,$status); 1313post_test($existkeys == 38 and $morekeys == 69); 1314 1315pre_test('ffghbn'); 1316$tfields = $ttype = $tform = $tunit = $binname = undef; 1317ffghbn($fptr,$nrows,$tfields,$ttype,$tform,$tunit,$binname,$pcount,$status); 1318post_test( 1319 $nrows == 21 and $tfields == 10 and $binname eq 'Test-BINTABLE' and $pcount == 0 and 1320 cmp_str_arrays($ttype,[qw( Avalue Lvalue Xvalue Bvalue Ivalue Jvalue Evalue Dvalue Cvalue Mvalue )]) and 1321 cmp_str_arrays($tform,[qw( 15A 1L 16X 1B 1I 1J 1E 1D 1C 1M )]) and 1322 cmp_str_arrays($tunit,['','m**2','cm','erg/s','km/s','','','','','']) 1323); 1324 1325pre_test('ffgcx'); 1326@$larray = map(0,(0..39)); 1327ffgcx($fptr,3,1,1,36,$larray,$status); 1328my $tmp = ''; 1329for ($ii=0;$ii<5;$ii++) { 1330 foreach ($ii*8..$ii*8+7) { $tmp .= $larray->[$_] } 1331 $tmp .= ' '; 1332} 1333post_test($tmp eq '01001100 01110000 11110000 01111100 00000000 '); 1334 1335my ($kinarray,$cinarray,$minarray,$xinarray); 1336@{$larray} = map(0,(0..$nrows-1)); 1337@{$xinarray} = map(0,(0..$nrows-1)); 1338@{$binarray} = map(0,(0..$nrows-1)); 1339@{$iinarray} = map(0,(0..$nrows-1)); 1340@{$kinarray} = map(0,(0..$nrows-1)); 1341@{$einarray} = map(0.0,(0..$nrows-1)); 1342@{$dinarray} = map(0.0,(0..$nrows-1)); 1343@{$cinarray} = map(0.0,(0..2*$nrows-1)); 1344@{$minarray} = map(0.0,(0..2*$nrows-1)); 1345 1346pre_test('ffgcvs'); 1347ffgcvs($fptr,1,4,1,1,'',$inskey,$anynull,$status); 1348post_test($inskey->[0] eq ''); 1349 1350$nrows=21; 1351ffgcvs($fptr,1,1,1,$nrows,'NOT DEFINED',$inskey,$anynull,$status); 1352ffgcvl($fptr,2,1,1,$nrows,0,$larray,$anynull,$status); 1353ffgcvb($fptr,3,1,1,$nrows,98,$xinarray,$anynull,$status); 1354ffgcvb($fptr,4,1,1,$nrows,98,$binarray,$anynull,$status); 1355ffgcvi($fptr,5,1,1,$nrows,98,$iinarray,$anynull,$status); 1356ffgcvj($fptr,6,1,1,$nrows,98,$kinarray,$anynull,$status); 1357ffgcve($fptr,7,1,1,$nrows,98.,$einarray,$anynull,$status); 1358ffgcvd($fptr,8,1,1,$nrows,98.,$dinarray,$anynull,$status); 1359ffgcvc($fptr,9,1,1,$nrows,98.,$cinarray,$anynull,$status); 1360ffgcvm($fptr,10,1,1,$nrows,98.,$minarray,$anynull,$status); 1361 1362