startmacro
!
! Author : Ken Smith
! Version: $Id: test_split_group.mm,v 1.13 2012/10/23 16:55:14 jxc Exp $
!
! Test/demo macro for primitives SPLIT and GROUP, they're not
! easy to test separately
!
! JPH -- Added the following
! (1) Fixed type-2000 test
! (2) Fixed conversion of ASCII format to SB.
! (3) Separated the tests so that it is easier to locate where there are
!     problems.  
!  JPH - TBD -- Need to be able to use the COMPARE command on type 2000,..
!  then we can remove do_compare routine.
!  Also, need better ways to create test files so we do not have to use
!  convert and other tricks to do it.  I tried to use "FILE OPEN...
!  and "result FILE(filename)..." syntax ... no luck.
!

switch "DEBUG" dbg GET
if "^dbg" EQS "" then
  result dbg 1
endif

result outStatus 1

result stab {}

result l:ind 1
call get_unique test1
call get_unique test2
call get_unique test3
call get_unique test4
call get_unique test5
call get_unique test6
call get_unique test7
call get_unique test8
call get_unique test9
call get_unique test10
call get_unique test2000
call get_unique test3000
call get_unique testA
call get_unique testShort
result s:grp1000     "testgrp_1000"
result s:split1000   "testgrp_split"
result s:grp2000     "testgrp_2000"
result s:truth2000   "testgrp_2000truth"
result s:split2000   "testgrp_2000split"
result s:split3000   "testgrp_3000split"
result s:grpASCII    "testgrp_ascii"
result s:splitASCII  "testgrp_asciisplit"
result s:splitshort  "testgrp_shortsplit"
!
! Try type-1000, type-2000 and type-3000 files, with different
!   data types
!
result nel 10
waveform test1 sb nel   constant 1
waveform test2 si nel   constant 2
waveform test3 sl nel   constant 3
waveform test4 sf nel   constant 4
waveform test5 sd nel   constant 5
header/create testA sr=(SR01/SA,SR02/SA,SR03/SA,SR04/SA,SR05/SA,SR06/SA,SR07/SA,SR08/SA,SR09/SA,SR10/SA))
file open/d/w tag testA
forall #=1:9 res tag.setdata(0,SR0#) "A"
res tag.setdata(0,SR10) "A"
file close tag
headermod testA format=1A type=1000

waveform test6 sb nel*2 constant 6
headermod test6 format=cb
waveform test7 si nel*2 constant 7
headermod test7 format=ci
waveform test8 sl nel*2 constant 8
headermod test8 format=cl
waveform test9 sf nel*2 constant 9
headermod test9 format=cf
waveform test10 sd nel*2 constant 10
headermod test10 format=cd
!
group grp1000 test1 test2 test3 test4 test5 test6 test7 test8 test9 test10
!
split grp1000 ^split1000
result status -1
do i 1 10 1
  result s:file1 test^i
  if i le 9 
    result s:file2 "^{split1000}sr0^i"
  else
    result s:file2 "^{split1000}sr^i"
  endif
  call do_compare ^file1 ^file2 status
  if status LT 0 then
     break
  endif
enddo
ASSERT/DEBUG=^DBG/TEXT="SPLIT_GROUP: 1000"/STAT=stab.sg1000 status GT 0
if ^stab.sg1000 NEQS "PASS" result outStatus -1

!
! Create a "TRUTH" type-1000 file for comparison.  Create a type-2000 file 
! to be grouped with another 1000 file and then split for comparison.
!
waveform ^test2000 si nel*2 constant 11
waveform ^truth2000 si nel constant 11
headermod ^test2000 type=2000 fs=2
group ^grp2000 ^test1 ^test2000
split ^grp2000 ^split2000
!
! FCALC doesn't like type-2000 files (DR #4781)
!
result status -1
do i 2 3 1
  result s:file1 ^truth2000
  result s:file2 "^{split2000}sr0^i"
  call do_compare ^file1 ^file2 status
  if status LT 0 then
     break
  endif
enddo
ASSERT/DEBUG=^DBG/TEXT="SPLIT_GROUP: 2000"/STAT=stab.sg2000 status GT 0
if ^stab.sg2000 NEQS "PASS" result outStatus -1

!
! Our type-3000 file got split all the way down to type-1000
!
group test3000 test1 test2 test3
split test3000 ^split3000
result status -1
do i 1 3 1
  result s:file1 test^i
  result s:file2 "^{split3000}sr0^i"
  call do_compare ^file1 ^file2 status
  if status LT 0 then
    break
  endif
enddo
ASSERT/DEBUG=^DBG/TEXT="SPLIT_GROUP: 3000"/STAT=stab.sg3000 status GT 0
if ^stab.sg3000 NEQS "PASS" result outStatus -1

!
!  Test performance with ASCII data type
!
!
group grpascii test1 testA
split grpascii ^{splitASCII}

call do_compare_ascii ^testA "^{splitASCII}sr02"
if ^stab.ascii NEQS "PASS" result outStatus -1
!
!  Test performance with short subrecord names
!
group ^testShort test1 test1 test1
headermod ^testShort sr(3)=(sh,sb,2)
split ^testShort ^splitshort
if "^{splitshort}sh" nfexists then
  call cleanup
  error "Failed short subrecord test"
  stop
endif
call cleanup

endmacro
!-----------------------------------------------------------------------------
procedure get_unique u:file
!
 result s:^file testgrp^{env.pid}^{ind}
 calc/quiet l:ind ind 1 +
!
return
!-----------------------------------------------------------------------------
procedure do_compare s:infile1 s:infile2 U:out
!
! Compare two files
! This can be replaced by the COMPARE command once DR 4782 is fixed.
!
  result D:toler 1e-6
  result l:ok 1
  result status 1

  status infile1 size=num1
  status infile2 size=num2
  calc/verbose=false l:num num1 num2 min

  file open/d handle1 infile1
  file open/d handle2 infile2

  do l:i 1 num-1 1
    result d:testval1 handle1.data(^{i})
    result d:testval2 handle2.data(^{i})
    calc/quiet eqt_test testval1 testval2 - abs &
                          testval1 abs testval2 abs max /
    if eqt_test gt toler then 
       if dbg GT 0 say "Test difference = ^eqt_test, tolerance = ^toler"
       result l:ok 0          
    endif
  enddo

  file close handle1
  file close handle2

  if ok lt 0.5 then
    result status -1
  endif
  result ^out status
!
return
!-----------------------------------------------------------------------------
procedure do_compare_ascii s:infile1 s:infile2
!
! Compare two files
! This can be replaced by the COMPARE command once DR 4782 is fixed.
!
  result l:ok 1
!
  status infile1 size=num1
  status infile2 size=num2
  calc/quiet l:num num1 num2 min

  file open/d handle1 infile1
  file open/d handle2 infile2
!
  do l:i 0 num-1 1

    result s:testval1 ^handle1.data(^{i})
    result s:testval2 ^handle2.data(^{i})

    if "^testval1" EQS "^testval2" then
      ! ok
    else
      result l:ok 0
    endif
  enddo

  file close handle1
  file close handle2

  ASSERT/DEBUG=^DBG/TEXT="SPLIT_GROUP: ascii"/STAT=stab.ascii ok GT 0.5

return
!-----------------------------------------------------------------------------
procedure cleanup
!
! Clean up our files (it would be nice if there were a /NOWARN switch to allow
! deleting optional files quietly, this would avoid the "if" test here).
!

! Erase file from type 1000 test
  do i 1 10
    if ^test^i    fexists erase/verbose=false ^test^i
  enddo
  if ^{grp1000} fexists erase/verbose=false ^{grp1000}
  do i 1 9
    if "^{split1000}sr0^{i}" fexists erase/verbose=false "^{split1000}sr0^{i}"
  enddo
  do i 10 10
    if "^{split1000}sr^{i}" fexists erase/verbose=false "^{split1000}sr^{i}"
  enddo

! Erase file from type 2000 test
  if ^test2000     fexists erase/verbose=false ^test2000
  if ^grp2000      fexists erase/verbose=false ^grp2000
  if ^truth2000    fexists erase/verbose=false ^truth2000
  do i 1 3
    if "^{split2000}sr0^{i}" fexists erase/verbose=false "^{split2000}sr0^{i}"
  enddo

! Erase files for type-3000 test
  if ^test3000   fexists erase/verbose=false ^test3000
  do i 1 3
    if "^{split3000}sr0^{i}" fexists erase/verbose=false "^{split3000}sr0^{i}"
  enddo

! Erase files for ASCII test
  if ^testA       fexists erase/verbose=false ^testA
  if ^grpASCII    fexists erase/verbose=false ^grpASCII
  do i 1 11
    if i LT 10 then                                                                
      if "^{splitASCII}sr0^{i}" fexists erase/verbose=false "^{splitASCII}sr0^{i}" 
    else                                                                           
      if "^{splitASCII}sr^{i}" fexists erase/verbose=false "^{splitASCII}sr^{i}"  
    endif                                                                          
  enddo

! Erase files for short test
  result tmp ^{testshort}
  if ^tmp   fexists erase/verbose=false ^tmp
  if "^{splitshort}sh"   fexists erase/verbose=false "^{splitshort}sh"
  do i 1 2
    if "^{splitshort}sr0^{i}" fexists erase/verbose=false "^{splitshort}sr0^{i}"
  enddo
!
return
