c**********************************************************************c
c  Description: Test case for M$*PICK, i.e. routines for retrieving
c               arguments from the command line (CMDLINE). This tests
c               the basic functionality of the various picks while
c               test_args.for tests the various converstions.
c
c  Author:      Neon Ngo
c  Version:     $Id: test_picks.for,v 1.3 2009/08/06 00:04:39 ntn Exp $
c**********************************************************************c
        program TEST_PICKS
        implicit none
        include 'primitive.inc'
        include 'assert.inc'
        character*(L_max_ascii) aval
        integer*4 val
        real*8    wsec
        real*8    fsec
        character*1 type
        real*8      dval
        character*(L_max_ascii) cbuf
        character*2 twocharstr

        call M$CHECKIN
        call ASSERT_AUTOINIT('DEBUG','STAT')

        call ASSERT('Testing M$PPICK 1',.not. M$PPICK(1))
        call ASSERT('Testing M$PPICK 2',M$PPICK(2))
        call ASSERT('Testing M$DPICK 1',(M$DPICK(1) .eq. 0d0))
        call ASSERT('Testing M$DPICK 4',M$DPICK(4) .eq. 42d0)
        call ASSERT('Testing M$FPICK 4',M$FPICK(4) .eq. 42e0)
        call ASSERT('Testing M$LPICK 4',M$LPICK(4) .eq. 42)
        call ASSERT('Testing M$IPICK 4',M$IPICK(4) .eq. 42)
        call ASSERT('Testing M$BPICK 4',M$BPICK(4) .eq. 42)
        call ASSERT('Testing M$SPICK for F',(.not. M$SPICK(8)))
        call ASSERT('Testing M$SPICK for T',(M$SPICK(9)))

c       Need tests for M$CPICK, M$QPICK

        val = M$TPICK(2,wsec,fsec)
        call ASSERT('Testing M$TPICK yyyy:mm:dd::hh:mm:ss.sss '
     &              //'precision',(val .ge. 1))
        call ASSERT('Testing M$TPICK yyyy:mm:dd::hh:mm:ss.sss wsec',
     &              (wsec .eq. 1767996829d0))
        call ASSERT('Testing M$TPICK yyyy:mm:dd::hh:mm:ss.sss fsec',
     &              (fsec .eq. 0.987d0))

        val = M$TPICK(10,wsec,fsec)
        call ASSERT('Testing M$TPICK <sec> precision ',
     &              (val .eq. 2))
        call ASSERT('Testing M$TPICK <sec> wsec',
     &              (wsec .eq. 1854642006d0))
        call ASSERT('Testing M$TPICK <sec> fsec',
     &              (fsec .eq. 0.813d0))

c       BUG 1514 - XBC: TPICK does not support wsec|fsec syntax
c       NTN: test case for using NeXtMidas (wsec,fsec) time syntax
        val = M$TPICK(11,wsec,fsec)
        call ASSERT('Testing M$TPICK (<wsec>,<fsec>) precision ',
     &              (val .eq. 2))
        call ASSERT('Testing M$TPICK (<wsec>,<fsec>) wsec',
     &              (wsec .eq. 1854642006d0))
        call ASSERT('Testing M$TPICK (<wsec>,<fsec>) fsec',
     &              (fsec .eq. 0.123456789d0))

c       BUG 1514 - XBC: TPICK does not support wsec|fsec syntax
c       NTN: this sytnax is supported but deprecated
        val = M$TPICK(12,wsec,fsec)
        call ASSERT('Testing M$TPICK <wsec>|<fsec> precision ',
     &              (val .eq. 2))
        call ASSERT('Testing M$TPICK <wsec>|<fsec> wsec',
     &              (wsec .eq. 1846621740d0))
        call ASSERT('Testing M$TPICK <wsec>|<fsec> fsec',
     &              (fsec .eq. 0.1d0))

c       BUG 1514 - XBC: TPICK does not support wsec|fsec syntax
c       NTN: this sytnax is supported but deprecated
c       Test to make sure it behaves like X-Midas (wsec is truncated,
c       and fsec only looks at the fraction part of fsec and does not
c       carry over to wsec)
        val = M$TPICK(13,wsec,fsec)
        call ASSERT('Testing M$TPICK <wsec>|<fsec> precision ',
     &              (val .eq. 2))
        call ASSERT('Testing M$TPICK <wsec>|<fsec> (truncated) wsec',
     &              (wsec .eq. 1846621740d0))
        call ASSERT('Testing M$TPICK <wsec>|<fsec> fsec',
     &              (fsec .eq. 0.7d0))

        aval = M$APICK(2)
        val  = M$LENGTH(aval)
        call ASSERT('Testing M$APICK',(aval(1:val) .eq.
     &                '2006:01:09::22:13:49.987'))

        aval = M$UPICK(4)
        val  = M$LENGTH(aval)
        call ASSERT('Testing M$UPICK', (aval(1:val) .eq. 'MYVAL'))

c       BUG 1933 - test that last character is NOT stripped off
        val = M$UAPICK(4,twocharstr,0)
        call ASSERT('Testing M$AUPICK does NOT strip of last char for'//
     &              ' Bug 1933',(twocharstr(1:val) .eq. 'MY'))

c JC4: test case for m$_pick (which isn't implemented yet)
c        type = M$_PICK(4,cbuf,dval)
c        write(*,*) 'M$_PICK type=',type,' dval=',dval
c        write(*,*) '        cbuf=',cbuf
c        call ASSERT('Testing M$_PICK, type=L', type .eq. 'L')
c        call ASSERT('Testing M$_PICK, dval=42', dval .eq. 42d0)

c        type = M$_PICK(5,cbuf,dval)
c        write(*,*) 'M$_PICK type=',type,' dval=',dval
c        write(*,*) '        cbuf=',cbuf
c        call ASSERT('Testing M$_PICK, type=A', type .eq. 'A')
c        call ASSERT('Testing M$_PICK, dval=5', dval .eq. 5d0)
c        call ASSERT('Testing M$_PICK, cbuf=MYSTR',
c     &              cbuf(1:5) .eq. 'MYSTR')


        call M$SYNC
        call M$RETURN
        call ASSERT_AUTOREPORT()
        end

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