c**********************************************************************c
c  Description: Tests state transitions for HPrimitive.java. Should
c               always be called with:
c                  /ID=<name> P1=<do_sync> P2=<do_return>
c
c  Author:      J. Czechowski IV
c  Version:     $Id: test_states.for,v 1.2 2007/11/06 00:21:01 jph Exp $
c**********************************************************************c
        program TEST_STATES
        implicit none
        include 'primitive.inc'
        include 'assert.inc'
        character*(L_max_ascii) id
        integer*4               lid
        logical*4               do_sync
        logical*4               do_return

        call M$CHECKIN
        lid       = M$GET_USWITCH('ID', id)
        do_sync   = M$SPICK(1)
        do_return = M$SPICK(2)

        call ASSERT_AUTOINIT('DEBUG','STAT')

        call CHECK_STATES(id(1:lid), 'OPEN')
        
        if (do_sync) then
          call M$SYNC
          call CHECK_STATES(id(1:lid), 'PROCESS')
        endif
        
        if (do_return) then
          call M$RETURN
          call CHECK_STATES(id(1:lid), 'CLOSE')
        endif

        call ASSERT_AUTOREPORT()
        end

c**********************************************************************c
c       Checks the host state of the given primitive.
c**********************************************************************c
        subroutine CHECK_STATES(id, state)
          implicit none
          include 'primitive.inc'
          include 'assert.inc'
          character*(*)           id
          character*(*)           state
          character*(L_max_ascii) str
          integer*4               lstr

          str  = 'REG.'//id//'.HOSTSTATE'
          lstr = M$LENGTH(str)
          call CHECK_STATE(str(1:lstr),state)

          str  = 'REG.'//id//'.STATE'
          lstr = M$LENGTH(str)
          call CHECK_STATE(str(1:lstr),state)
        end

c**********************************************************************c
c Only used by CHECK_STATES
c**********************************************************************c
        subroutine CHECK_STATE(str,exp)
          implicit none
          include 'primitive.inc'
          include 'assert.inc'
          character*(*)           str
          character*(*)           exp
          character*(L_max_ascii) state
          character               type
          integer*4               len
          real*8                  dval

          type = M$RFIND(str,state,dval)

          if (type .eq. 'A') then
            len = M$LENGTH(state)
            call M$UPPERCASE(state)
            call ASSERT('Checking for '//str//'='
     &                  //exp//' got '//state(1:len),
     &                  (state(1:len) .eq. exp))
          else
            call ASSERT('Could not find REG.'//str,.false.)
          endif
        end

c**********************************************************************c
c       Include assertion facility.
c**********************************************************************c
        include 'assert.for'
