startmacro
!
! Author: Ken Smith/ Jay Hallam
! Version: $Id: test_split.mm,v 1.8 2003/07/30 16:11:37 hallamj Exp $
!
! Test/demo macro for primitive SPLIT
! The amount of testing that can be done here is limited, more
!   is possible with GROUP, see macro TEST_SPLIT_GROUP
!
result l:ind 1
result d:toler 6e-5
result l:nel 12
!
call get_unique temp1
waveform temp1 sf nel sawtooth 40 .25 0 0 1
headermod temp1 type=3000 rl=16 sr(1)=(sr00,sf,0) sr(2)=(sr01,sf,4) &
                nsr=3         sr(3)=(sr02,sf,8) 
call get_unique temp2
split temp1 temp2
!
! The output from the above should be two type-1000 files and a type-2000
!   file
!
status ^{temp2}sr00 type=l:type size=l:nel format=s:fmt
ASSERT/TEXT="SPLIT: SR00 file status" type EQ 1000  AND  nel EQ 3  AND fmt EQS "SF"
call do_compare "^{temp2}sr00" -40 3 status
ASSERT/TEXT="SPLIT: SR00 compare" status GT 0
call do_compare "^{temp2}sr01" -20 3 status
ASSERT/TEXT="SPLIT: SR01 compare" status GT 0
!
status ^{temp2}sr02 type=l:type size=l:nel format=s:fmt
ASSERT/TEXT="SPLIT: SR02 status, type= ^type, format= ^fmt, size= ^nel" &
      type EQ 2000  AND  nel EQ 3  AND fmt EQS "SF" 

call get_unique temp3 
waveform temp3 sf 6 sq 10 .5 0 0 1
fcalc temp3 temp3 10 +
!
! FCALC can't cope with this type 2000 file without an 
!    ArrayIndexOutOfBoundsException, as per DR 4781
!
headermod "^{temp2}sr02" type=1000
fcalc temp3 "^{temp2}sr02" temp3 -
call do_compare "^temp3" 0 6 status
ASSERT/TEXT="SPLIT: SR02 compare" status GT 0

call cleanup

endmacro
!-----------------------------------------------------------------------------
procedure get_unique u:file
!
  result s:^file "uniq^{env.pid}^{ind}"
  calcul/quiet l:ind ind 1 +
!
return
!-----------------------------------------------------------------------------
procedure do_compare s:infile d:val l:num U:out
!
! Compare a (supposedly) constant file against the correct value
! This can be replaced by the COMPARE command once DR 4782 is fixed.
!
  result status 1
  result l:ok 1
!
  file open/d handle infile
!
  do i 1 num 1
    result d:testval handle.data(i-)
    calc/quiet eqt_test val testval - abs val abs 1e-6 max /
    if eqt_test gt toler then 
       result l:ok 0          
    endif
  enddo
!
  file close handle
!
  if ok lt 0.5 then
    result status -1
  endif
  result ^out status
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).
!
result sr00 ^{temp2}sr00
result sr01 ^{temp2}sr01
result sr02 ^{temp2}sr02

  if ^temp1       fexists erase/verbose=false ^temp1
  if ^sr00 fexists erase/verbose=false ^sr00
  if ^sr01 fexists erase/verbose=false ^sr01
  if ^sr02 fexists erase/verbose=false ^sr02
  if ^temp3       fexists erase/verbose=false ^temp3
!
return

