test_suite_M_process Subroutine

subroutine test_suite_M_process()

Uses

setup teardown

Arguments

None

Contents

Source Code


Subroutines

subroutine test_process_close()

call process_close(fp,ierr) ! not open yet call unit_check(‘process_close’, ierr.ne.0, ‘close process before opening it’,ierr) call unit_check(‘process_close’, ierr.eq.0, ‘close process that is open’,ierr)

Arguments

None

subroutine test_process_open_read()

call unit_check(‘process_open_read’, ierr.eq.0, ‘close ierr=’,ierr)

Arguments

None

subroutine test_process_open_write()

Arguments

None

subroutine test_process_readall()

Arguments

None

subroutine test_process_readline()

Arguments

None

subroutine test_process_writeline_array()

Arguments

None

subroutine test_process_writeline_scalar()

Arguments

None

Source Code

subroutine test_suite_M_process()
use M_framework__verify, only : unit_check_start,unit_check,unit_check_done,unit_check_good,unit_check_bad,unit_check_msg
use M_process

!! setup
   call test_process_open_read()
   call test_process_open_write()
   call test_process_readall()
   call test_process_readline()
   call test_process_writeline_array()
   call test_process_writeline_scalar()
   call test_process_close()
!! teardown
contains
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_process_close()
type(streampointer) :: fp              ! C file pointer returned by process_open()
integer :: ierr                        ! check status of calls to process module routines
character(len=:),allocatable :: string ! hold results, assuming sufficient memory is available
character(len=4096) :: line            ! long enough to hold any expected line
   call unit_check_start('process_close',msg='')
   string=''
   !!call process_close(fp,ierr)             ! not open yet
   !!call unit_check('process_close', ierr.ne.0, 'close process before opening it',ierr)
   call process_open_read('echo A;echo B;echo C',fp,ierr)    ! open process to read from
   do                                      ! read output of process till end
      call process_readline(line,fp,ierr)
      if(ierr.ne.0)exit
      string=string//trim(line)//' '       ! append output lines together
   enddo
   call unit_check_msg('process_close','string=',string )
   call process_close(fp,ierr)             ! Wrap up
   call unit_check('process_close', ierr.eq.0, 'close process ',ierr)
   call process_open_write('cat',fp,ierr)    ! open process to write to that is not terminated
   call process_close(fp,ierr)
   !!call unit_check('process_close', ierr.eq.0, 'close process that is open',ierr)
   call unit_check_done('process_close',msg='')
end subroutine test_process_close
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_process_open_read()
type(streampointer) :: fp                                                  ! C file pointer returned by process_open()
integer :: ierr                                                            ! check status of calls to process module routines
character(len=:),allocatable :: string                                     ! hold results, assuming sufficient memory is available
character(len=4096) :: line                                                ! long enough to hold any expected line
  call unit_check_start('process_open_read',msg='')
  string=''
  call process_open_read('echo a;echo b;echo c',fp,ierr)                   ! open process to read from
  call unit_check('process_open_read', ierr.eq.0, 'open ierr=',ierr)
  do                                                                       ! read output of process till end
     call process_readline(line,fp,ierr)
     if(ierr.ne.0)exit
     string=string//trim(line)//'+'                                        ! append output lines together
  enddo
  call unit_check('process_open_read', string.eq.'a+b+c+', string)
  call process_open_read('echo a;echo b;echo c',fp,ierr)                   ! open process to read from
  call unit_check('process_open_read', string.eq.'a+b+c+', 'open already open process,ierr=',ierr)
  call process_close(fp,ierr)                                              ! Wrap up
  !!call unit_check('process_open_read', ierr.eq.0, 'close ierr=',ierr)
  call unit_check_done('process_open_read',msg='')
end subroutine test_process_open_read
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_process_open_write()
type(streampointer)          :: fp            ! C file pointer returned by process_open()
integer                      :: ierr          ! check status of calls to process module routines
integer                      :: lun
integer                      :: ios
character(len=256)           :: line
   call unit_check_start('process_open_write',msg='')
   ! clear scratch file
   open(newunit=lun,file='_scratch_.txt',iostat=ios)
   close(unit=lun,iostat=ios,status='delete')
   ! start shell with command that finishes immediately (special case, would just use execute_command_line(3f) intrinsic)
   call process_open_write('echo one >_scratch_.txt;echo two >>_scratch_.txt',fp,ierr)    ! open process to write to
   call unit_check('process_open_write', ierr.eq.0, 'ierr=',ierr)
   call process_close(fp,ierr)
   call unit_check('process_open_write', ierr.eq.0, 'no error on close, ierr=',ierr)
   ! check expected file
   open(newunit=lun,file='_scratch_.txt')
   read(lun,'(a)',iostat=ios)line
   call unit_check('process_open_write', line.eq.'one', 'line 1:',line)
   read(lun,'(a)',iostat=ios)line
   call unit_check('process_open_write', line.eq.'two', 'line 2:',line)
   close(unit=lun,iostat=ios,status='delete')
   ! start shell that waits to read commands
   call process_open_write('bash||cmd',fp,ierr)    ! open process to write to
   call unit_check('process_open_write', ierr.eq.0, 'ierr=',ierr)
   call process_writeline('echo three >_scratch_.txt',fp,ierr)
   call unit_check('process_open_write', ierr.ge.0, 'write of "echo three >_scratch_.txt", ierr=',ierr)
   call process_writeline('echo four >>_scratch_.txt',fp,ierr)
   call unit_check('process_open_write', ierr.ge.0, 'write of "echo four >>_scratch_.txt", ierr=',ierr)
   call process_close(fp,ierr)
   call unit_check('process_open_write', ierr.eq.0, 'should now be closed, ierr=',ierr)
   ! check expected file
   open(newunit=lun,file='_scratch_.txt')
   read(lun,'(a)',iostat=ios)line
   call unit_check('process_open_write', line.eq.'three',  'line 1:',line)
   read(lun,'(a)',iostat=ios)line
   call unit_check('process_open_write', line.eq.'four',   'line 2:',line)
   close(unit=lun,iostat=ios,status='delete')
   !
   call unit_check_done('process_open_write',msg='')
end subroutine test_process_open_write
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_process_readall()
integer :: ierr
character(len=:),allocatable :: string
   string=process_readall('echo A;echo B;echo C',ierr=ierr)
   call unit_check_start('process_readall',msg='')
   call unit_check('process_readall', string.eq.'A B C', string)
   call unit_check_done('process_readall',msg='')
end subroutine test_process_readall
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_process_readline()
type(streampointer) :: fp                                                   ! C file pointer returned by process_open()
integer :: ierr                                                             ! check status of calls to process module routines
character(len=:),allocatable :: string                                      ! hold results, assuming sufficient memory is available
character(len=4096) :: line                                                 ! long enough to hold any expected line
   call unit_check_start('process_readline',msg='')
   string=''
   call process_open_read('echo a;echo b;echo c',fp,ierr)                   ! open process to read from
   do                                                                       ! read output of process till end
      call process_readline(line,fp,ierr)
      if(ierr.ne.0)exit
      string=string//trim(line)//'+'                                        ! append output lines together
   enddo
   call unit_check('process_readline', string.eq.'a+b+c+', string)
   call process_close(fp,ierr)                                              ! Wrap up
   call unit_check_done('process_readline',msg='')
end subroutine test_process_readline
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_process_writeline_array()
type(streampointer)          :: fp            ! C file pointer returned by process_open()
integer                      :: ierr          ! check status of calls to process module routines
integer                      :: lun
integer                      :: ios
integer                      :: i
character(len=:),allocatable :: text(:)
character(len=*),parameter   :: lines(*)=[character(len=10) :: 'one','two','three','four']
character(len=256)           :: line
   call unit_check_start('process_writeline_array',msg='')
   ! clear scratch file
   open(newunit=lun,file='_scratch_.txt',iostat=ios)
   close(unit=lun,iostat=ios,status='delete')
   ! start shell
   call process_open_write('bash||cmd',fp,ierr)    ! open process to write to
   ! feed commands to shell that redirect output to _scratch_.txt file
   text=[character(len=128) ::      &
      "echo one   >_scratch_.txt",  &
      "echo two   >>_scratch_.txt", &
      "echo three >>_scratch_.txt", &
      "echo four  >>_scratch_.txt"]
   call process_writeline(text,fp,ierr)       ! multiple lines
   call unit_check('process_writeline_array',ierr.ge.0,'wrote four lines, ierr=',ierr)
   call process_close(fp,ierr)
   ! check expected file
   open(newunit=lun,file='_scratch_.txt')
   do i=1,4
      read(lun,'(a)',iostat=ios)line
      if(ios.ne.0)exit
      call unit_check('process_writeline_array',line.eq.lines(i),'got ',line,'expected',line)
   enddo
   close(unit=lun,iostat=ios,status='delete')
   call unit_check('process_writeline_array',i.eq.5,'number of lines',i-1)
   call unit_check_done('process_writeline_array',msg='')
end subroutine test_process_writeline_array
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_process_writeline_scalar()
type(streampointer)          :: fp            ! C file pointer returned by process_open()
integer                      :: ierr          ! check status of calls to process module routines
integer                      :: lun
integer                      :: ios
integer                      :: i
character(len=*),parameter   :: lines(*)=[character(len=10) :: 'one','two','three','four']
character(len=256)           :: line
   call unit_check_start('process_writeline_scalar',msg='')
   ! clear scratch file
   open(newunit=lun,file='_scratch_.txt',iostat=ios)
   close(unit=lun,iostat=ios,status='delete')
   ! start shell
   call process_open_write('bash||cmd',fp,ierr)    ! open process to write to (ie. start gnuplot(1) program)
   ! feed commands to shell that redirect output to _scratch_.txt file
   call process_writeline('echo one    >_scratch_.txt',fp,ierr)
   call process_writeline('echo two   >>_scratch_.txt',fp,ierr)
   call process_writeline('echo three >>_scratch_.txt',fp,ierr)
   call process_writeline('echo four  >>_scratch_.txt',fp,ierr)
   call process_close(fp,ierr)
   ! check expected file
   open(newunit=lun,file='_scratch_.txt')
   do i=1,size(lines)
      read(lun,'(a)',iostat=ios)line
      if(ios.ne.0)exit
      call unit_check('process_writeline_scalar',line.eq.lines(i),line)
   enddo
   close(unit=lun,iostat=ios,status='delete')
   call unit_check('process_writeline_scalar',i.eq.5,'number of lines',i)

   call unit_check_done('process_writeline_scalar',msg='')
end subroutine test_process_writeline_scalar
!===================================================================================================================================
end subroutine test_suite_M_process