program basic
!! STACK OF TESTS -- some systems will have a limit on how much process spawning is allowed
use M_CLI2, only : set_args, get_args
use M_CLI2, only : get_args_fixed_length, get_args_fixed_size
implicit none
integer :: casen=0
integer :: x,y,z
integer :: ithree(3)
integer,allocatable :: ints(:)
real :: r_x,r_y,r_z
real :: rfour(4)
real,allocatable :: reals(:)
logical :: l_x,l_y
logical :: lfive(5)
logical,allocatable :: logicals(:)
character(len=30) :: string
complex :: c_x, c_y, c_z ! scalars
complex,allocatable :: c_aarr(:) ! allocatable array
complex :: c_three(3) ! fixed-size array
character(len=:),allocatable :: command
character(len=4096) :: cmd
integer :: e
integer :: i
character(len=*),parameter :: gen='(*(g0,1x))'
call get_command_argument(0,cmd) ! get name of this executable
e=len_trim(cmd)+1
command=' &
& --ints 11,22,33 &
& -x 10 -y 20 -z 10#30 &
& --ithree -1,-2,-3 &
! character
& -string "My string,""again" &
! real
& -r_x -8 -r_y -88 -r_z -888 &
& --reals 1.2,2.3,3.4,4.5,5.6,6.7,7.8 &
& --rfour 1.1,2.2,3.3,4.4 &
! logical
& --logicals T:.true:.TRUE.:.false.:F:FALSE:TRUE -l_x T -l_y F -lfive T,F,T,F,T &
! complex
& --c_three -999,-999,-999,-999,-999,-999 &
& -c_x -999,-999 -c_y -999,-999 -c_z -999,-999 &
& --c_aarr -999:-999::-999:-999 &
! case number
& -casen 0 &
&'
call readcli() ! assume initially called with no parameters so that parameters are default values
select case(casen)
case(0)
write(6,*)'COMMAND:',command
write(6,*)'check defaults'
write(6,*)'default integers'
call printit(all([x,y,z,ints,ithree].eq.[10,20,30,11,22,33,-1,-2,-3]))
write(6,*)'default reals scalar'
call printit(all([r_x,r_y,r_z].eq.[-8.0,-88.0,-888.0]))
write(6,*)'default reals fixed array'
call printit(all(rfour.eq.[1.1,2.2,3.3,4.4]))
write(6,*)'default allocatable array'
write(*,*)reals
write(*,*)[1.2,2.3,3.4,4.5,5.6,6.7,7.8]
call printit(all(reals.eq.[1.2,2.3,3.4,4.5,5.6,6.7,7.8]))
write(6,*)'default logicals'
call printit(all([l_x ,l_y,lfive,logicals].eqv. &
& [.true., .false., .true., .false., .true., .false., .true., .true., .true., .true., .false., .false., .false., .true.]))
write(6,*)'default complex'
call printit(all([c_x,c_y,c_z,c_three,c_aarr].eq. [(cmplx(-999,-999),i=1,8)]))
call runit('-x 4 -y 5 -z 6 -casen 1') ! now call itself with some values specified
case(1)
write(6,*)'scalar ints'
call printit(all([x,y,z].eq.[4,5,6])) ! options set on command line in previous case
call runit('-r_x 40 -r_y 50 -r_z 60 -casen 2')
case(2)
write(6,*)'scalar reals'
call printit(all([r_x,r_y,r_z].eq.[40.0,50.0,60.0]))
call runit('-x 400 -y 500 -z 600 --ints -1,-2,-3 --ithree -11,-22,-33 -casen 3')
case(3)
call printit(all([x,y,z,ints,ithree].eq.[400,500,600,-1,-2,-3,-11,-22,-33]))
call runit('-c_x "(1,2)" -c_y 10,20 -c_z "(2#111,16#-AB)" -c_three 1,2,3,4,5,6 -c_aarr 111::222,333::444 -casen 4')
case(4)
! test results for case 4
write(6,gen)'CASE4 EXPECTED:',&
[cmplx(1.0,2.0),cmplx(10.0,20.0),cmplx(7,-171),cmplx(1,2),cmplx(3,4),cmplx(5,6),cmplx(111,222),cmplx(333,444)]
write(6,gen)'CASE4 RESULTS:',[c_x,c_y,c_z,c_three,c_aarr]
write(6,gen)'CASE4 TESTS:',[c_x,c_y,c_z,c_three,c_aarr].eq.&
& [cmplx(1.0,2.0),cmplx(10.0,20.0),cmplx(7,-171),cmplx(1,2),cmplx(3,4),cmplx(5,6),cmplx(111,222),cmplx(333,444)]
call printit(all([c_x,c_y,c_z,c_three,c_aarr].eq.&
& [cmplx(1.0,2.0),cmplx(10.0,20.0),cmplx(7,-171),cmplx(1,2),cmplx(3,4),cmplx(5,6),cmplx(111,222),cmplx(333,444)]))
flush(unit=6)
! run next case
call runit('-x 400 -y 500 -z 600 --ints -1,-2,-3 -casen 900')
case(5)
case(6)
case(7)
case(8)
case(9)
case(900)
write(6,*)'USAGE'
flush(unit=6)
call runit('--casen 901 --usage')
call runit('--casen 901')
case(901)
write(6,*)'HELP'
flush(unit=6)
call runit('--casen 902 --help')
call runit('--casen 902')
case(902)
write(6,*)'VERSION'
flush(unit=6)
call runit('--casen 999 --version')
call runit('--casen 999')
case(999)
case default
write(6,'(a)')'default - should not get here'
flush(unit=6)
stop
end select
contains
subroutine runit(string)
character(len=*),intent(in) :: string
write(6,*)'RUN:',string
flush(unit=6)
call execute_command_line(cmd(:e)//string)
end subroutine runit
subroutine printit(testit)
logical testit
write(6,'(*(g0,1x))',advance='no')'CASE ',casen,merge('PASSED:','FAILED:',testit)
write(6,'(/,a)')repeat('=',132)
flush(unit=6)
end subroutine printit
subroutine readcli()
flush(unit=6)
call set_args(command)
! integer
call get_args('x',x)
call get_args('y',y)
call get_args('z',z)
call get_args('ints',ints)
call get_args_fixed_size('ithree',ithree)
! logical
call get_args('l_x',l_x)
call get_args('l_y',l_y)
call get_args('logicals',logicals)
call get_args_fixed_size('lfive',lfive)
! real
call get_args('r_x',r_x)
call get_args('r_y',r_y)
call get_args('r_z',r_z)
call get_args('reals',reals)
call get_args_fixed_size('rfour',rfour)
! character
call get_args_fixed_length('string',string)
! complex
call get_args('c_x',c_x)
call get_args('c_y',c_y)
call get_args('c_z',c_z)
call get_args('c_aarr',c_aarr)
call get_args_fixed_size('c_three',c_three)
!
call get_args('casen',casen)
end subroutine readcli
end program basic