test_suite_M_system_tests Subroutine

subroutine test_suite_M_system_tests()
use,intrinsic :: iso_c_binding,   only : c_int32_t, c_int, c_ptr, c_size_t, c_short, c_float, c_char, c_null_char
use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64, real32, real64, real128
use M_msg,     only : str
use M_verify,   only : unit_check, unit_check_start, unit_check_good, unit_check_bad, unit_check_done
use M_verify,   only : unit_check_msg
use M_verify,   only : unit_check_level
use M_system
use M_process, only : process_readall
use M_time,    only : fmtdate, u2d
integer :: ierr
!! setup
   ierr=system_rmdir('fort.10')
   ierr=system_rmdir('_test1')
   ierr=system_rmdir('_test2')
   ierr=system_rmdir('_test3')

call unit_check_msg('M_system','try to test OS interface routines, given difficulty of trying to test')
call unit_check_msg('M_system','functions not intrinsically part of Fortran and system-dependent.')
call unit_check_msg('M_system','Many assumptions are made, including assuming a GNU Linux/Unix system.')
call unit_check_msg('M_system','Examine the tests on other platforms, as it may well be the assumptions made')
call unit_check_msg('M_system','about the system and not the routines that are generating an error.')
call test_set_environment_variable()
call test_system_rename()
call test_system_getlogin()
call test_system_geteuid()
call test_system_getegid()
call test_system_getgid()
call test_system_getuid()
call test_system_getpid()
call test_system_getppid()
call test_system_isdir()
call test_system_chdir()
call test_system_rmdir()
call test_system_mkdir()
call test_system_opendir()
call test_system_readdir()
call test_system_rewinddir()
call test_system_closedir()
call test_system_putenv()
call test_system_unsetenv()
call test_system_getenv()
call test_system_initenv()
call test_system_readenv()
call test_system_remove()
call test_system_getcwd()

   call test_system_dir()
   call test_system_clearenv()
   call test_system_access()
   call test_system_chmod()
   call test_system_chown()
   call test_system_cpu_time()
   call test_system_errno()
   call test_system_getgrgid()
   call test_system_gethostname()
   call test_fileglob()

   call test_system_getpwuid()
   call test_system_getsid()
   call test_system_setsid()
   call test_system_getumask()
   call test_system_isblk()
   call test_system_ischr()
   call test_system_isfifo()
   call test_system_islnk()
   call test_system_isreg()
   call test_system_issock()
   call test_system_kill()
   call test_system_link()
   call test_system_mkfifo()
   call test_system_perm()
   call test_system_perror()
   call test_system_rand()
   call test_system_srand()
   call test_system_realpath()
   call test_system_setumask()
   call test_system_stat()
   !-!call test_system_stat_print()
   call test_system_uname()
   call test_system_unlink()
   call test_system_utime()
   call test_system_memcpy()
!! teardown
   ierr=system_rmdir('fort.10')
   ierr=system_rmdir('_test1')
   ierr=system_rmdir('_test2')
   ierr=system_rmdir('_test3')
contains
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
!-!subroutine test_system_stat_print()
!-!   call unit_check_start('system_stat_print',msg='')
!-!   call system_stat_print('/tmp')
!-!   call system_stat_print('/etc/hosts')
!-!   !!call unit_check('system_stat_print', 0.eq.0, 'checking',100)
!-!   call unit_check_done('system_stat_print',msg='')
!-!end subroutine test_system_stat_print
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_srand()
integer :: i,j
   do j=1,2
      call system_srand(1001)
      do i=1,10
         write(*,*)system_rand()
      enddo
      write(*,*)
   enddo
   call unit_check_start('system_srand',msg='')
   !!call unit_check('system_srand', 0.eq.0, 'checking',100)
   call unit_check_done('system_srand',msg='')
end subroutine test_system_srand
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_kill()
integer           :: i,pid,ios,ierr,signal=9
character(len=80) :: argument

   do i=1,command_argument_count()
! get arguments from command line
      call get_command_argument(i, argument)
! convert arguments to integers assuming they are PID numbers
      read(argument,'(i80)',iostat=ios) pid
      if(ios.ne.0)then
         write(*,*)'bad PID=',trim(argument)
      else
         write(*,*)'kill SIGNAL=',signal,' PID=',pid
! send signal SIGNAL to pid PID
         ierr=system_kill(pid,signal)
! write message if an error was detected
         if(ierr.ne.0)then
            call system_perror('*test_system_kill*')
         endif
      endif
   enddo
   call unit_check_start('system_kill',msg='')
   !!call unit_check('system_kill', 0.eq.0, 'checking',100)
   call unit_check_done('system_kill',msg='')
end subroutine test_system_kill
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_errno()
integer :: stat
   stat=system_unlink('not there/OR/anywhere')
   if(stat.ne.0)then
      write(*,*)'err=',system_errno()
      call system_perror('*test_system_errno*')
   endif
   call unit_check_start('system_errno',msg='')
   !!call unit_check('system_errno', 0.eq.0, 'checking',100)
   call unit_check_done('system_errno',msg='')
end subroutine test_system_errno
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_geteuid()
                     integer :: ierr
character(len=:),allocatable :: string
integer                      :: uid_command
integer                      :: uid
   call unit_check_start('system_geteuid',msg='check using command "id -u"')
   string=process_readall('id -u',ierr=ierr)
   !!call unit_check('system_geteuid', ierr.eq.0, 'using command "id -u" ierr=',ierr,'effective UID=',string)
   call unit_check('system_geteuid', string.ne.' ', 'using command "id -u" ierr=',ierr,'effective UID=',string)
   uid=system_geteuid();
   if(string.ne.'')then
      read(string,*)uid_command
      call unit_check('system_geteuid', uid.eq.uid_command, 'uid=',uid)
      call unit_check_done('system_geteuid',msg='')
   else
      call unit_check_bad('system_geteuid', msg=str(' assuming bad because system command did not work. uid=',uid))
   endif
end subroutine test_system_geteuid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getuid()
integer                      :: ierr
character(len=:),allocatable :: string
integer                      :: uid_command
integer                      :: uid
integer                      :: ios
   call unit_check_start('system_getuid',msg='check using command "id -u -r"')
   string=process_readall('id -u -r',ierr=ierr)
   !!call unit_check('system_getuid', ierr.eq.0, 'using command "id -u -r" ierr=',ierr,'UID=',string)
   call unit_check('system_getuid', string.ne.' ', 'using command "id -u -r" ierr=',ierr,'UID=',string)
   uid=system_getuid();
   if(string.ne.' ')then
      read(string,*,iostat=ios)uid_command
      call unit_check('system_getuid', ios.eq.0, 'read uid=',uid_command)
      call unit_check('system_getuid', uid.eq.uid_command, 'uid=',uid)
      call unit_check_done('system_getuid',msg='')
   else
      call unit_check_bad('system_getuid', msg=str(' assuming bad because system command did not work. uid=',uid))
   endif
end subroutine test_system_getuid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getegid()
integer                      :: ierr
character(len=:),allocatable :: string
integer                      :: gid_command
integer                      :: gid
character(len=*),parameter   :: cmd='id -g'
   call unit_check_start('system_getegid','check using command',cmd)
   string=process_readall(cmd,ierr=ierr)
   !!call unit_check('system_getegid', string.ne.' ', 'using command "',cmd,'" ierr=',ierr,'GID=',string)
   gid=system_getegid();
   if(string.ne.' ')then
      read(string,*)gid_command
      call unit_check('system_getegid', gid.eq.gid_command, 'gid=',gid)
      call unit_check_done('system_getegid',msg='')
   else
      call unit_check_bad('system_getegid', msg=str(' assuming bad because system command did not work. gid=',gid))
   endif
end subroutine test_system_getegid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getgid()
integer                      :: ierr
character(len=:),allocatable :: string
integer                      :: gid_command
integer                      :: gid
character(len=*),parameter   :: cmd='id -g -r'
   call unit_check_start('system_getgid','check using command',cmd)
   string=process_readall(cmd,ierr=ierr)
   !!call unit_check('system_getgid', ierr.eq.0, 'using command "',cmd,'" ierr=',ierr,'GID=',string)
   call unit_check('system_getgid', string.ne.' ', 'using command "',cmd,'" ierr=',ierr,'GID=',string)
   gid=system_getgid();
   if(string.ne.' ')then
      read(string,*)gid_command
      call unit_check('system_getgid', gid.eq.gid_command, 'gid=',gid)
      call unit_check_done('system_getgid',msg='')
   else
      call unit_check_bad('system_getgid', msg=str(' assuming bad because system command did not work. gid=',gid))
   endif
end subroutine test_system_getgid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getsid()
!!integer                      :: ierr
!!character(len=:),allocatable :: string
!!integer                      :: sid_command
integer                      :: sid
character(len=*),parameter   :: cmd='UNKNOWN'
   call unit_check_start('system_getsid','check using command',cmd)
!!   string=process_readall(cmd,ierr=ierr)
!!   call unit_check('system_getsid', ierr.eq.0, 'using command "',cmd,'" ierr=',ierr,'sid=',string)
   sid=system_getsid(0_c_int);
!!   if(string.ne.' ')then
!!      read(string,*)sid_command
!!      call unit_check('system_getsid', sid.eq.sid_command, 'sid=',sid)
      call unit_check_done('system_getsid',msg='')
!!   else
!!      call unit_check_bad('system_getsid', msg=str(' assuming bad because system command did not work. sid=',sid))
!!   endif
end subroutine test_system_getsid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_setsid()
integer                      :: pid
   call unit_check_start('system_setsid')
   pid=system_setsid();
   !!call unit_check('system_setsid', pid.ge.0, 'just checking PID>0 pid=',pid)
   call unit_check_done('system_setsid',msg='')
end subroutine test_system_setsid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getpid()
integer                      :: pid
   call unit_check_start('system_getpid','PID (process ID) of current process')
   pid=system_getpid();
   call unit_check('system_getpid', pid.ge.0, 'just checking PID>0 pid=',pid)
   call unit_check_done('system_getpid',msg='')
end subroutine test_system_getpid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getppid()
integer                      :: ppid
call unit_check_start('system_getppid','only make sure call does not work and returns value >0')
   ppid=system_getppid();
   call unit_check('system_getppid', ppid.ge.0, 'ppid=',ppid)
   call unit_check_done('system_getppid',msg='')
end subroutine test_system_getppid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_rand()
integer :: i

   call system_srand(1001)
   do i=1,10
      write(*,*)system_rand()
   enddo
   write(*,*)

   call unit_check_start('system_rand',msg='')
   !!call unit_check('system_rand', 0.eq.0, 'checking',100)
   call unit_check_done('system_rand',msg='')
end subroutine test_system_rand
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_initenv()
character(len=:),allocatable :: string
integer                      :: i
integer                      :: ierr
character(len=:),allocatable :: home
character(len=4096)          :: envname
   call unit_check_start('system_initenv',msg='assuming system always has environment variable HOME set')
   i=0
   home=''
   ! read environment table and look for HOME= at beginning of line
   call system_initenv()
   do
      string=system_readenv()
      if(index(string,'HOME=').eq.1)then
        home=string
      endif
      if(string.eq.'')then
         exit
      else
         i=i+1
      endif
   enddo
   call get_environment_variable("HOME",value=envname, status=ierr)
   envname='HOME='//trim(envname)
   call unit_check('system_initenv',home.eq.envname, 'HOME',home,envname)
   call unit_check_done('system_initenv',msg='')
end subroutine test_system_initenv
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_realpath()
! resolve each pathname given on command line
character(len=:),allocatable :: pathi,patho
integer                      :: i
integer                      :: filename_length
   do i = 1, command_argument_count()
! get pathname from command line arguments
      call get_command_argument (i , length=filename_length)
      allocate(character(len=filename_length) :: pathi)
      call get_command_argument (i , value=pathi)
!
! resolve each pathname
      patho=system_realpath(pathi)
      if(system_errno().eq.0)then
         write(*,*)trim(pathi),'=>',trim(patho)
      else
         call system_perror('*system_realpath* error for pathname '//trim(pathi)//':')
         write(*,*)trim(pathi),'=>',trim(patho)
      endif
      deallocate(pathi)
   enddo
! if there were no pathnames give resolve the pathname "."
   if(i.eq.1)then
      patho=system_realpath('.')
      write(*,*)'.=>',trim(patho)
   endif
   call unit_check_start('system_realpath',msg='')
   !!call unit_check('system_realpath', 0.eq.0, 'checking',100)
   call unit_check_done('system_realpath',msg='')
end subroutine test_system_realpath
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_fileglob()
   call unit_check_start('fileglob',msg='')
   !!call unit_check('fileglob', 0.eq.0, 'checking',100)
   call unit_check_done('fileglob',msg='')
end subroutine test_fileglob
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_set_environment_variable()

integer :: ierr
character(len=4096) :: value
   call unit_check_start('set_environment_variable',msg='')
!! CHECK NOT_THERE_S_E_V IS NOT THERE FOR TEST
   call get_environment_variable("NOT_THERE_S_E_V", status=ierr)
   call unit_check('set_environment_variable',ierr.eq.1,'make sure variable does not exist,status=',ierr)
!! SET THE VARIABLE NOT_THERE_S_E_V
   call set_environment_variable('NOT_THERE_S_E_V','this is the value',ierr)
!! CHECK VARIABLE IS NOW SET
   call unit_check('set_environment_variable',ierr.eq.0,'setting, status should be zero when setting=',ierr)
   call get_environment_variable("NOT_THERE_S_E_V", value=value,status=ierr)
   call unit_check('set_environment_variable',ierr.eq.0,'status should be zero when getting=',ierr)
   call unit_check('set_environment_variable',value.eq.'this is the value','value is set to:',value)
!! REPLACE VALUE
   call set_environment_variable('NOT_THERE_S_E_V','this is the new value',ierr)
   call unit_check('set_environment_variable',ierr.eq.0,'setting, status should be zero when setting=',ierr)
   call get_environment_variable("NOT_THERE_S_E_V", value=value,status=ierr)
   call unit_check('set_environment_variable',ierr.eq.0,'status should be zero when getting=',ierr)
   call unit_check('set_environment_variable',value.eq.'this is the new value','value is set to:',value)

   call unit_check_done('set_environment_variable',msg='')
end subroutine test_set_environment_variable
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_access()

integer                     :: i
character(len=80),parameter :: names(*)=[ &
      '/usr/bin/bash   ', &
      '/tmp/NOTTHERE   ', &
      '/usr/local      ', &
      '.               ', &
      'PROBABLY_NOT    ']
   do i=1,size(names)
      write(*,*)' does ',trim(names(i)),' exist?    ', system_access(names(i),F_OK)
      write(*,*)' is ',trim(names(i)),' readable?     ', system_access(names(i),R_OK)
      write(*,*)' is ',trim(names(i)),' writeable?    ', system_access(names(i),W_OK)
      write(*,*)' is ',trim(names(i)),' executable?   ', system_access(names(i),X_OK)
   enddo
   call unit_check_start('system_access',msg='')
   !!call unit_check('system_access', 0.eq.0, 'checking',100)
   call unit_check_done('system_access',msg='')
end subroutine test_system_access
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_chdir()
character(len=:),allocatable :: dirname
character(len=:),allocatable :: hold
integer             :: ierr
   call unit_check_start('system_chdir',msg='test system_chdir(3f) assuming Unix-like file system and system_getwd(3f) works')
   call system_getcwd(hold,ierr)

   call system_chdir('/tmp',ierr)
   call system_getcwd(dirname,ierr)
   call unit_check('system_chdir', dirname.eq.'/tmp', 'checking /tmp to',trim(dirname))

   call system_chdir('/',ierr)
   call system_getcwd(dirname,ierr)
   call unit_check('system_chdir', dirname.eq.'/', 'checking / to',dirname)

   call system_chdir(hold,ierr)
   call system_getcwd(dirname,ierr)
   call unit_check('system_chdir', dirname.eq.hold, 'checking ',hold,' to',dirname)

   call unit_check_done('system_chdir',msg='')
end subroutine test_system_chdir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_chmod()

integer             :: ierr
integer             :: status
integer(kind=int64) :: buffer(13)
integer             :: ios
character(len=4096) :: message

!Setting Read Permissions for User, Group, and Others
! The following example sets read permissions for the owner, group, and others.
   open(file='_test1',unit=10)
   write(10,*,iostat=ios,iomsg=message)'TEST FILE 1'
   if(ios.ne.0)then
      write(*,*)trim(message)
   endif

   flush(unit=10,iostat=ios,iomsg=message)
   if(ios.ne.0)then
      write(*,*)trim(message)
   endif

   close(unit=10,iostat=ios,iomsg=message)
   if(ios.ne.0)then
      write(*,*)trim(message)
   endif

   ierr=system_chmod('_test1', IANY([R_USR,R_GRP,R_OTH]))

   open(file='_test1',unit=10)
   close(unit=10,status='delete',iostat=ios,iomsg=message)
   if(ios.ne.0)then
      write(*,*)trim(message)
   endif

!Setting Read, Write, and Execute Permissions for the Owner Only
! The following example sets read, write, and execute permissions for the owner, and no permissions for group and others.
   open(file='_test2',unit=10)
   write(10,*)'TEST FILE 2'
   close(unit=10)
   ierr=system_chmod('_test2', RWX_U)
   open(file='_test2',unit=10)
   close(unit=10,status='delete')

!Setting Different Permissions for Owner, Group, and Other
! The following example sets owner permissions for CHANGEFILE to read, write, and execute, group permissions to read and
! execute, and other permissions to read.
   open(file='_test3',unit=10)
   write(10,*)'TEST FILE 3'
   close(unit=10)
   ierr=system_chmod('_test3', IANY([RWX_U,R_GRP,X_GRP,R_OTH]));
   open(file='_test3',unit=10)
   close(unit=10,status='delete')

!Setting and Checking File Permissions
! The following example sets the file permission bits for a file named /home/cnd/mod1, then calls the stat() function to
! verify the permissions.

   ierr=system_chmod("home/cnd/mod1", IANY([RWX_U,RWX_G,R_OTH,W_OTH]))
   call system_stat("home/cnd/mod1", buffer,status)

! In order to ensure that the S_ISUID and S_ISGID bits are set, an application requiring this should use stat() after a
! successful chmod() to verify this.

!    Any files currently open could possibly become invalid if the mode
!    of the file is changed to a value which would deny access to
!    that process.

   call unit_check_start('system_chmod',msg='')
   !!call unit_check('system_chmod', 0.eq.0, 'checking',100)
   call unit_check_done('system_chmod',msg='')
end subroutine test_system_chmod
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_chown()

integer                     :: i
character(len=80),parameter :: names(*)=[character(len=80) :: 'myfile1','/usr/local']
   do i=1,size(names)
      if(.not.  system_chown(&
      & trim(names(i)),  &
      & system_getuid(), &
      & system_getgid()) &
         )then
         call system_perror('*test_system_chown* '//trim(names(i)))
      endif
   enddo
   call unit_check_start('system_chown',msg='')
   !!call unit_check('system_chown', 0.eq.0, 'checking',100)
   call unit_check_done('system_chown',msg='')
end subroutine test_system_chown
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_clearenv()

! environment before clearing
   call execute_command_line('env|wc -l')
! environment after clearing (not necessarily blank!!)
   call system_clearenv()
   call execute_command_line('env')
   call unit_check_start('system_clearenv',msg='')
   !!call unit_check('system_clearenv', 0.eq.0, 'checking',100)
   call unit_check_done('system_clearenv',msg='')
end subroutine test_system_clearenv
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_closedir()

type(c_ptr)                  :: dir
character(len=:),allocatable :: filename
integer                      :: ierr
call unit_check_start('system_closedir',msg='test if can read from current directory, assumed non-empty and close and retry')
   call system_opendir('.',dir,ierr)      !--- open directory stream to read from
   call system_readdir(dir,filename,ierr) !--- read directory stream
   call unit_check('system_closedir', filename.ne.'', 'found a file named',filename)
   call system_closedir(dir,ierr)         !--- close directory stream
   call unit_check('system_closedir', ierr.eq.0, 'closing gave ierr=',ierr)
   !!!!!!! TRYING BAD OPERATION HANGS SYSTEMS. CANNOT FIND GENERIC TEST TO SEE IF OPEN
   !!call system_readdir(dir,filename,ierr)
   !!call unit_check('system_closedir', ierr.ne.0, 'try reading now should give error ierr=',ierr)
   !!!!!!!
   call unit_check_done('system_closedir',msg='')
end subroutine test_system_closedir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_cpu_time()

real    :: user_start, system_start, total_start
real    :: user_finish, system_finish, total_finish
integer :: i
real    :: value

   call system_cpu_time(total_start,user_start,system_start)

   value=0.0
   do i=1,1000000
      value=sqrt(real(i)+value)
   enddo
   write(*,*)'average sqrt value=',value/1000000.0
   call system_cpu_time(total_finish,user_finish,system_finish)
   write(*,*)'USER ......',user_finish-user_start
   write(*,*)'SYSTEM ....',system_finish-system_start
   write(*,*)'TOTAL .....',total_finish-total_start

   call unit_check_start('system_cpu_time',msg='')
   !!call unit_check('system_cpu_time', 0.eq.0, 'checking',100)
   call unit_check_done('system_cpu_time',msg='')
end subroutine test_system_cpu_time
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getcwd()
character(len=:),allocatable :: dirname
character(len=:),allocatable :: hold
integer                      :: ierr
   call unit_check_start('system_getcwd',msg='test system_getcwd(3f) assuming Unix-like file system')
   ! cache current directory so can return
   call system_getcwd(hold,ierr)
   call unit_check('system_getcwd', ierr.eq.0 , 'checking ierr on getting current directory=',ierr)

   call system_chdir('/tmp',ierr)
   call system_getcwd(dirname,ierr)
   call unit_check('system_getcwd', dirname.eq.'/tmp', 'checking /tmp to',dirname)

   call system_chdir('/',ierr)
   call system_getcwd(dirname,ierr)
   call unit_check('system_getcwd', dirname.eq.'/', 'checking / to',dirname)
   ! back to original
   call system_chdir(hold,ierr)
   call system_getcwd(dirname,ierr)
   call unit_check('system_getcwd', dirname.eq.hold, 'checking ',hold,' to',dirname)

   call unit_check_done('system_getcwd',msg='')
end subroutine test_system_getcwd
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getenv()
character(len=256)           :: var
character(len=256)           :: envname
character(len=*),parameter   :: names(*)=[character(len=10)::'USER','HOME','LOGNAME','USERNAME']
integer                      :: i
integer                      :: ierr
   call unit_check_start('system_getenv',msg='')
   do i=1,size(names)
      var=system_getenv(names(i))
      call get_environment_variable(names(i),value=envname, status=ierr)
      call unit_check('system_getenv', envname.eq.var, names(i),var,envname)
   enddo
   call unit_check_done('system_getenv',msg='')
end subroutine test_system_getenv
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getgrgid()
integer(kind=int64)          :: gid
character(len=:),allocatable :: name
   gid=system_getgid()
   name=system_getgrgid( gid )
   write(*,'("group[",a,"] for ",i0)')name,system_getgid()
   call unit_check_start('system_getgrgid',msg='')
   !!call unit_check('system_getgrgid', 0.eq.0, 'checking',100)
   call unit_check_done('system_getgrgid',msg='')
end subroutine test_system_getgrgid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_gethostname()
character(len=:),allocatable :: name
integer                      :: ierr

   call system_gethostname(name,ierr)
   if(ierr.eq.0)then
      write(*,'("hostname[",a,"]")')name
   else
      write(*,'(a)')'ERROR: could not get hostname'
   endif

   call unit_check_start('system_gethostname',msg='')
   !!call unit_check('system_gethostname', 0.eq.0, 'checking',100)
   call unit_check_done('system_gethostname',msg='')
end subroutine test_system_gethostname
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getlogin()
character(len=80) :: envname
character(len=:),allocatable :: name
integer                      :: ierr
   call unit_check_start('system_getlogin',msg=' test system_getlogin(3f) against environment variable')
   call get_environment_variable("USER",value=envname, status=ierr)
   if(envname.eq.'')then
      call get_environment_variable("LOGNAME",value=envname, status=ierr)
   endif
   if(envname.eq.'')then
      call get_environment_variable("USERNAME",value=envname, status=ierr)
   endif
   if(envname.eq.'')then
      call unit_check_msg('system_getlogin',' did not find username in environment, test invalid')
   else
      name=system_getlogin()
      call unit_check('system_getlogin', name.eq.envname, 'checking',envname,'versus',name)
   endif
   call unit_check_done('system_getlogin',msg='')
end subroutine test_system_getlogin
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getpwuid()
character(len=:),allocatable :: name
integer(kind=int64)          :: uid
   uid=system_getuid()
   name=system_getpwuid(uid)
   write(*,'("login[",a,"] has UID ",i0)')name,uid
   call unit_check_start('system_getpwuid',msg='')
   !!call unit_check('system_getpwuid', 0.eq.0, 'checking',100)
   call unit_check_done('system_getpwuid',msg='')
end subroutine test_system_getpwuid
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_getumask()
integer :: i
   write(*,101)(system_getumask(),i=1,4)
101 format(1x,i0,1x,"O'",o4.4,"'",1x,'Z"',z0,"'",1x,"B'",b12.12,"'")
   call unit_check_start('system_getumask',msg='')
   !!call unit_check('system_getumask', 0.eq.0, 'checking',100)
   call unit_check_done('system_getumask',msg='')
end subroutine test_system_getumask
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_isblk()
integer                     :: i
character(len=80),parameter :: names(*)=[ &
      '/tmp            ', &
      '/tmp/NOTTHERE   ', &
      '/usr/local      ', &
      '.               ', &
      'block_device.tst', &
      'PROBABLY_NOT    ']
   do i=1,size(names)
      write(*,*)' is ',trim(names(i)),' a block device? ', system_isblk(names(i))
   enddo
   call unit_check_start('system_isblk',msg='')
   !!call unit_check('system_isblk', 0.eq.0, 'checking',100)
   call unit_check_done('system_isblk',msg='')
end subroutine test_system_isblk
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_ischr()
integer                     :: i
character(len=80),parameter :: names(*)=[ &
      '/tmp            ', &
      '/tmp/NOTTHERE   ', &
      '/usr/local      ', &
      '.               ', &
      'char_dev.test   ', &
      'PROBABLY_NOT    ']
   do i=1,size(names)
      write(*,*)' is ',trim(names(i)),' a character device? ', system_ischr(names(i))
   enddo
   call unit_check_start('system_ischr',msg='')
   !!call unit_check('system_ischr', 0.eq.0, 'checking',100)
   call unit_check_done('system_ischr',msg='')
end subroutine test_system_ischr
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_isdir()
integer                     :: i
character(len=80),parameter :: names(*)=[ &
      '/tmp            ', &
      '/tmp/NOTTHERE   ', &
      '/bin/           ', &
      '.               ', &
      'PROBABLY_NOT    ']
logical,parameter           :: expected(*)=[.true., .false., .true., .true., .false.]
logical                     :: answer
   call unit_check_start('system_isdir',msg='')
   do i=1,size(names)
      answer=system_isdir(names(i))
      call unit_check('system_isdir', answer.eqv.expected(i), names(i))
   enddo
   call unit_check_done('system_isdir',msg='')
end subroutine test_system_isdir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_isfifo()
integer                     :: i
character(len=80),parameter :: names(*)=[ &
      '/tmp            ', &
      '/tmp/NOTTHERE   ', &
      '/usr/local      ', &
      '.               ', &
      'fifo.test       ', &
      'PROBABLY_NOT    ']
   do i=1,size(names)
      write(*,*)' is ',trim(names(i)),' a fifo(named pipe)? ', system_isfifo(names(i))
   enddo
   call unit_check_start('system_isfifo',msg='')
   !!call unit_check('system_isfifo', 0.eq.0, 'checking',100)
   call unit_check_done('system_isfifo',msg='')
end subroutine test_system_isfifo
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_islnk()
integer                     :: i
character(len=80),parameter :: names(*)=[ &
      '/tmp            ', &
      '/tmp/NOTTHERE   ', &
      '/usr/local      ', &
      '.               ', &
      'link.test       ', &
      'PROBABLY_NOT    ']
   do i=1,size(names)
      write(*,*)' is ',trim(names(i)),' a link? ', system_islnk(names(i))
   enddo
   call unit_check_start('system_islnk',msg='')
   !!call unit_check('system_islnk', 0.eq.0, 'checking',100)
   call unit_check_done('system_islnk',msg='')
end subroutine test_system_islnk
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_isreg()
integer                     :: i
character(len=80),parameter :: names(*)=[ &
      '/tmp            ', &
      'test.txt        ', &
      '.               ']
   do i=1,size(names)
      write(*,*)' is ',trim(names(i)),' a regular file? ', system_isreg(names(i))
   enddo
   call unit_check_start('system_isreg',msg='')
   !!call unit_check('system_isreg', 0.eq.0, 'checking',100)
   call unit_check_done('system_isreg',msg='')
end subroutine test_system_isreg
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_issock()

integer                     :: i
character(len=80),parameter :: names(*)=[ &
      '/tmp            ', &
      '/tmp/NOTTHERE   ', &
      '/usr/local      ', &
      '.               ', &
      'sock.test       ', &
      'PROBABLY_NOT    ']
   do i=1,size(names)
      write(*,*)' is ',trim(names(i)),' a socket? ', system_issock(names(i))
   enddo
   call unit_check_start('system_issock',msg='')
   !!call unit_check('system_issock', 0.eq.0, 'checking',100)
   call unit_check_done('system_issock',msg='')
end subroutine test_system_issock
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_link()

integer :: ierr
   ierr = system_link('myfile1','myfile2')
   if(ierr.ne.0)then
      call system_perror('*test_system_link*')
   endif
   call unit_check_start('system_link',msg='')
   !!call unit_check('system_link', 0.eq.0, 'checking',100)
   call unit_check_done('system_link',msg='')
end subroutine test_system_link
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_mkdir()

integer :: ierr
   call unit_check_start('system_mkdir',msg='make and remove _scratch/')
   ierr=system_mkdir('_scratch',IANY([R_USR,W_USR,X_USR]))
   call unit_check('system_mkdir', ierr.eq.0, 'make _scratch/, ierr=',ierr)
   call unit_check_msg('system_mkdir',system_isdir('_scratch'),'looks like the directory was made')
   call system_chdir('_scratch',ierr)
   call system_chdir('..',ierr)
   call unit_check_msg('system_mkdir',ierr.eq.0,'looks like it can be entered')
   ierr=system_rmdir('_scratch')
   call unit_check('system_mkdir', ierr.eq.0, 'remove _scratch/, ierr=',ierr)
   call unit_check_done('system_mkdir',msg='')
end subroutine test_system_mkdir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_mkfifo()

integer :: status
   status = system_mkfifo("/home/cnd/mod_done", IANY([W_USR, R_USR, R_GRP, R_OTH]))
   if(status.ne.0)then
      call system_perror('*mkfifo* error:')
   endif
   call unit_check_start('system_mkfifo',msg='')
   !!call unit_check('system_mkfifo', 0.eq.0, 'checking',100)
   call unit_check_done('system_mkfifo',msg='')
end subroutine test_system_mkfifo
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_opendir()
type(c_ptr)                  :: dir
character(len=:),allocatable :: filename
integer                      :: i
integer                      :: ierr
   call unit_check_start('system_opendir',msg='')
   call system_opendir('.',dir,ierr)                                              !--- open directory stream to read from
   call unit_check('system_opendir', ierr.eq.0, 'checking ierr=',ierr)
   i=0
   do                                                                             !--- read directory stream
      call system_readdir(dir,filename,ierr)
      if(filename.eq.' ')exit
      i=i+1
   enddo
   call system_closedir(dir,ierr)                                                 !--- close directory stream
   call unit_check_done('system_opendir',msg='')
end subroutine test_system_opendir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_perm()

character(len=4096) :: string
integer(kind=int64) :: values(13)
integer             :: ierr
character(len=:),allocatable :: perms
   values=0
   call get_command_argument(1, string)  ! get pathname from command line
   call system_stat(string,values,ierr)  ! get pathname information
   if(ierr.eq.0)then
      perms=system_perm(values(3))       ! convert permit mode to a string
! print permits as a string, decimal value, and octal value
      write(*,'("for ",a," permits[",a,"]",1x,i0,1x,o0)') &
         trim(string),perms,values(3),values(3)
   endif
   call unit_check_start('system_perm',msg='')
   !!call unit_check('system_perm', 0.eq.0, 'checking',100)
   call unit_check_done('system_perm',msg='')
end subroutine test_system_perm
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_perror()

character(len=:),allocatable :: DIRNAME
   DIRNAME='/NOT/THERE/OR/ANYWHERE'
! generate an error with a routine that supports errno and perror(3c)
   if(system_rmdir(DIRNAME).ne.0)then
      call system_perror('*test_system_perror*:'//DIRNAME)
   endif
   write(*,'(a)')"That's all Folks!"
   call unit_check_start('system_perror',msg='')
   !!call unit_check('system_perror', 0.eq.0, 'checking',100)
   call unit_check_done('system_perror',msg='')
end subroutine test_system_perror
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_putenv()

character(len=4096) :: value
integer             :: ierr
   call unit_check_start('system_putenv',msg='')
!! CHECK NOT_THERE_S_P IS NOT THERE FOR TEST
   call get_environment_variable("NOT_THERE_S_P", status=ierr)
   call unit_check('system_putenv',ierr.eq.1,'make sure variable does not exist,status=',ierr)
!! SET THE VARIABLE NOT_THERE_S_P
   call system_putenv('NOT_THERE_S_P=this is the value',ierr)
!! CHECK VARIABLE IS NOW SET
   call unit_check('system_putenv',ierr.eq.0,'setting, status should be zero when setting=',ierr)
   call get_environment_variable("NOT_THERE_S_P", value=value,status=ierr)
   call unit_check('system_putenv',ierr.eq.0,'status should be zero when getting=',ierr)
   call unit_check('system_putenv',value.eq.'this is the value','value is set to:',value)
!! REPLACE VALUE
   call system_putenv('NOT_THERE_S_P=this is the new value',ierr)
   call unit_check('system_putenv',ierr.eq.0,'setting, status should be zero when setting=',ierr)
   call get_environment_variable("NOT_THERE_S_P", value=value,status=ierr)
   call unit_check('system_putenv',ierr.eq.0,'status should be zero when getting=',ierr)
   call unit_check('system_putenv',value.eq.'this is the new value','value is set to:',value)
!! DELETE VALUE
   call system_putenv('NOT_THERE_S_P',ierr)
   call get_environment_variable("NOT_THERE_S_P", status=ierr)
   call unit_check('system_putenv',ierr.eq.1,'should be gone, varies with different putenv(3c)',ierr)
   call unit_check_msg('system_putenv','system_unsetenv(3f) is a better way to remove variables')
!!
   call unit_check_done('system_putenv',msg='')
end subroutine test_system_putenv
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_readdir()

type(c_ptr)                  :: dir
character(len=:),allocatable :: filename
integer                      :: ierr
character(len=256)           :: message
integer                      :: ios
integer                      :: lun
logical                      :: found1,found2
   call unit_check_start('system_readdir',msg='make some scratch files and look for their name in current directory')
   found1=.false.
   found2=.false.
!--- create two scratch files of known names

   open(newunit=lun,file='__scratch_1__',iostat=ios,iomsg=message)
   if(ios.eq.0)then
      write(lun,*)'SCRATCH FILE 1'
   else
      call unit_check_msg('system_readdir','error:',message)
   endif
   close(unit=lun,iostat=ios,iomsg=message)

   open(newunit=lun,file='__scratch_2__',iostat=ios,iomsg=message)
   if(ios.eq.0)then
      write(lun,*)'SCRATCH FILE 2'
   else
      call unit_check_msg('system_readdir','error:',message)
   endif
   close(unit=lun,iostat=ios,iomsg=message)

!--- open directory stream to read from
   call system_opendir('.',dir,ierr)
   call unit_check('system_opendir', ierr.eq.0, 'system_opendir ierr=',ierr)
!--- read directory stream and look for scratch file names
      do
         call system_readdir(dir,filename,ierr)
         if(filename.eq.' ') exit
         call unit_check('system_readdir', ierr.eq.0, 'system_readdir ierr=',ierr,'filename=',filename)
         if(ierr.ne.0) exit
         if(filename.eq.'__scratch_1__')found1=.true.
         if(filename.eq.'__scratch_2__')found2=.true.
      enddo
!--- close directory stream
   call system_closedir(dir,ierr)
   call unit_check('system_readdir', ierr.eq.0, 'system_closedir ierr=',ierr)

   call unit_check('system_readdir', found1, '__scratch__1',found1)
   call unit_check('system_readdir', found2, '__scratch__2',found2)

!--- remove scratch files
   open(newunit=lun,file='__scratch_1__',iostat=ios,iomsg=message)
   close(unit=lun,iostat=ios,iomsg=message,status='delete')
   open(newunit=lun,file='__scratch_2__',iostat=ios,iomsg=message)
   close(unit=lun,iostat=ios,iomsg=message,status='delete')

   call unit_check_done('system_readdir',msg='')
end subroutine test_system_readdir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_readenv()
character(len=:),allocatable :: string
integer                      :: i
integer                      :: ierr
character(len=:),allocatable :: home
character(len=4096)          :: envname
   call unit_check_start('system_readenv',msg='assuming system always has environment variable HOME set')
   i=0
   home=''
   ! read environment table and look for HOME= at beginning of line
   call system_initenv()
   do
      string=system_readenv()
      if(index(string,'HOME=').eq.1)then
        home=string
      endif
      if(string.eq.'')then
         exit
      else
         i=i+1
      endif
   enddo
   call get_environment_variable("HOME",value=envname, status=ierr)
   envname='HOME='//trim(envname)
   call unit_check('system_readenv',home.eq.envname, 'HOME',home,envname)
   call unit_check_done('system_readenv',msg='')
end subroutine test_system_readenv
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_remove()
character(len=*),parameter :: FILE='__MyJunkFile.txt'
integer                    :: ierr
integer                    :: ios
character(len=256)         :: message
   call unit_check_start('system_remove',msg='')
   ierr=system_remove(FILE) ! note intentionally causes error if file exists
   open(unit=10,file=FILE,iostat=ios,status='NEW')
   if(ios.eq.0)then
      write(10,'(a)',iostat=ios)'This is a file to be deleted by the test of system_remove(3f)'
      close(unit=10,iostat=ios)
      call unit_check('system_remove',system_isreg(FILE),msg='checking if test file exists before remove')
   else
      call unit_check('system_remove', ios.eq.0, 'bad I/O IOSTAT=',ios,message)
   endif
   ierr=system_remove(FILE)
   call unit_check('system_remove', ierr.eq.0, 'checking return code',ierr)
   call unit_check('system_remove',.not.system_isreg(FILE),msg='checking if test file exists after remove')
   call unit_check('system_remove',.not.system_access(FILE,F_OK),msg='checking if test file exists after remove')
   call unit_check_done('system_remove',msg='')
end subroutine test_system_remove
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_rename()

character(len=256) :: string
character(len=256) :: message
integer            :: ios
integer            :: ierr
   call unit_check_start('system_rename',msg='check system_rename(3f) renaming "_scratch_file_" to "_renamed_scratch_file_"')
   message=''
! try to remove junk files just in case
   ierr=system_remove('_scratch_file_')
   ierr=system_remove('_renamed_scratch_file_')
! create scratch file to rename
   close(unit=10,iostat=ios,status='delete')
   open(unit=10,file='_scratch_file_',status='new',iostat=ios)
   call unit_check('system_rename', ios.eq.0, 'message from OPEN(3f) is:',message,' ios is',ios)
   write(10,'(a)',iostat=ios,iomsg=message) 'IF YOU SEE THIS RENAME WORKED'
   close(unit=10)
! rename scratch file
   ierr=system_rename('_scratch_file_','_renamed_scratch_file_')
   call unit_check('system_rename', ierr.eq.0, 'ierr',ierr)
! read renamed file
   open(unit=11,file='_renamed_scratch_file_',status='old')
   read(11,'(a)',iostat=ios)string
   call unit_check('system_rename', ios.eq.0, 'ios',ierr)
   call unit_check('system_rename', string.eq.'IF YOU SEE THIS RENAME WORKED', string)
   close(unit=11)
! clean up
   ierr=system_remove('_scratch_file_')
   call unit_check('system_rename', ierr.ne.0, 'cleanup',ierr)
   ierr=system_remove('_renamed_scratch_file_')
   call unit_check('system_rename', ierr.eq.0, 'cleanup',ierr)
   call unit_check_done('system_rename',msg='')
end subroutine test_system_rename
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_rewinddir()
type(c_ptr)                  :: dir
character(len=:),allocatable :: filename
integer                      :: sum(2)
integer                      :: i
integer                      :: j
integer                      :: ierr
   call unit_check_start('system_rewinddir',msg='')
   call system_opendir('.',dir,ierr)                   ! open directory stream to read from
   do i=1,2                                            ! read directory stream twice
      j=0
      do
         call system_readdir(dir,filename,ierr)
         if(filename.eq.' ')exit
         j=j+1
      enddo
      sum(i)=j
      call system_rewinddir(dir)                       ! rewind directory stream
   enddo
   call system_closedir(dir,ierr)                      ! close directory stream
   call unit_check('system_rewinddir', sum(1).eq.sum(2), 'number of files','PASS 1:',sum(1),'PASS 2:',sum(2))
   call unit_check_done('system_rewinddir',msg='')
end subroutine test_system_rewinddir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_rmdir()

   integer :: ierr
   character(len=*),parameter :: dirname='_scratch_rmdir'
!! setup
   call unit_check_start('system_rmdir',msg='')
   if(system_isdir(dirname))then ! TRY TO CREATE
      call unit_check_msg('system_rmdir',dirname,'directory existed')
   endif
   ierr=system_mkdir(dirname,RWX_U)
   call unit_check('system_rmdir',ierr.eq.0,'try to create',dirname)
   call unit_check('system_rmdir',system_isdir(dirname),'check if',dirname,'exists and is a directory')
!! test
   ierr=system_rmdir(dirname) ! TRY TO REMOVE
   call unit_check('system_rmdir',ierr.eq.0,'check ierr',ierr)
   call unit_check('system_rmdir',.not.system_isdir(dirname),'check if',dirname,'is still a directory')

   if(system_isdir(dirname))then
      call unit_check_bad('system_rmdir',msg=str('testing went bad,',dirname,'is still a directory'))
   else
      ierr=system_rmdir(dirname) ! TRY TO REMOVE scratch directory when it should be gone
      call unit_check('system_rmdir',ierr.ne.0,'check ierr',ierr)
      call system_perror('*test of system_rmdir*')
   endif

   call unit_check_done('system_rmdir',msg='')
end subroutine test_system_rmdir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_setumask()

integer :: newmask
integer :: old_umask
integer :: i
   write(*,101)(system_getumask(),i=1,4)
101 format(1x,i0,1x,"O'",o4.4,"'",1x,'Z"',z0,"'",1x,"B'",b12.12,"'")
   newmask=63
   old_umask=system_setumask(newmask)
   write(*,*)'NEW'
   write(*,101)(system_getumask(),i=1,4)
   call unit_check_start('system_setumask',msg='')
   !!call unit_check('system_setumask', 0.eq.0, 'checking',100)
   call unit_check_done('system_setumask',msg='')
end subroutine test_system_setumask
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_stat()

integer(kind=int64)  :: buff(13)
integer(kind=int32)  :: status
character(len=*),parameter :: fmt_date='year-month-day hour:minute:second'
integer(kind=int64)  :: &
   Device_ID,           Inode_number,          File_mode,                  Number_of_links,  Owner_uid,         &
   Owner_gid,           Directory_device,      File_size,                  Last_access,      Last_modification, &
   Last_status_change,  Preferred_block_size,  Number_of_blocks_allocated
character(len=:),allocatable         :: temp
integer              :: dat(8)
equivalence                                    &
   ( buff(1)  , Device_ID                  ) , &
   ( buff(2)  , Inode_number               ) , &
   ( buff(3)  , File_mode                  ) , &
   ( buff(4)  , Number_of_links            ) , &
   ( buff(5)  , Owner_uid                  ) , &
   ( buff(6)  , Owner_gid                  ) , &
   ( buff(7)  , Directory_device           ) , &
   ( buff(8)  , File_size                  ) , &
   ( buff(9)  , Last_access                ) , &
   ( buff(10) , Last_modification          ) , &
   ( buff(11) , Last_status_change         ) , &
   ( buff(12) , Preferred_block_size       ) , &
   ( buff(13) , Number_of_blocks_allocated )

   call system_stat("/etc/hosts", buff, status)

   if (status == 0) then
      write (*, FMT="('Device ID(hex/decimal):',      T30, Z0,'h/',I0,'d')") buff(1),buff(1)
      write (*, FMT="('Inode number:',                T30, I0)") buff(2)
      write (*, FMT="('File mode (octal):',           T30, O19)") buff(3)
      write (*, FMT="('Number of links:',             T30, I0)") buff(4)
      write (*, FMT="('Owner''s uid/username:',       T30, I0,1x, A)") buff(5), system_getpwuid(buff(5))
      write (*, FMT="('Owner''s gid/group:',          T30, I0,1x, A)") buff(6), system_getgrgid(buff(6))
      write (*, FMT="('Device where located:',        T30, I0)") buff(7)
      write (*, FMT="('File size(bytes):',            T30, I0)") buff(8)
      dat=u2d(int(buff(9)))
      temp=fmtdate(dat,fmt_date) ! kludge for ifort (IFORT) 2021.3.0 20210609
      write (*, FMT="('Last access time:',            T30, I0,1x, A)") buff(9), temp
      dat=u2d(int(buff(10)))
      temp=fmtdate(dat,fmt_date) ! kludge for ifort (IFORT) 2021.3.0 20210609
      write (*, FMT="('Last modification time:',      T30, I0,1x, A)") buff(10),temp
      dat=u2d(int(buff(11)))
      temp=fmtdate(dat,fmt_date) ! kludge for ifort (IFORT) 2021.3.0 20210609
      write (*, FMT="('Last status change time:',     T30, I0,1x, A)") buff(11),temp
      write (*, FMT="('Preferred block size(bytes):', T30, I0)") buff(12)
      write (*, FMT="('No. of blocks allocated:',     T30, I0)") buff(13)
   endif

   call unit_check_start('system_stat',msg='')
   !!call unit_check('system_stat', 0.eq.0, 'checking',100)
   call unit_check_done('system_stat',msg='')
end subroutine test_system_stat
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_uname()

integer,parameter          :: is=100
integer                    :: i
character(len=*),parameter :: letters='srvnmxT'
character(len=is)          :: string=' '

   write(*,'(80("="))')
   do i=1,len(letters)
      call system_uname(letters(i:i),string)
      write(*,*)'=====> TESTING system_uname('//letters(i:i)//')--->'//trim(string)
   enddo
   write(*,'(80("="))')
   call unit_check_start('system_uname',msg='')
   !!call unit_check('system_uname', 0.eq.0, 'checking',100)
   call unit_check_done('system_uname',msg='')
end subroutine test_system_uname
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_unlink()

integer :: ierr
   ierr = system_unlink('myfile1')
   if(ierr.ne.0)then
      call system_perror('*test_system_unlink*')
   endif
   call unit_check_start('system_unlink',msg='')
   !!call unit_check('system_unlink', 0.eq.0, 'checking',100)
   call unit_check_done('system_unlink',msg='')
end subroutine test_system_unlink
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_unsetenv()

integer :: ierr
character(len=4096) :: value

   call system_unsetenv('GRU')

   call unit_check_start('system_unsetenv',msg='')

!! SET THE VARIABLE NOT_THERE_S_U
   call set_environment_variable('NOT_THERE_S_U','this is the value',ierr)
!! CHECK VARIABLE IS NOW SET
   call get_environment_variable("NOT_THERE_S_U", value=value,status=ierr)
   call unit_check('system_unsetenv',ierr.eq.0,'status should be zero when getting=',ierr)
   call unit_check('system_unsetenv',value.eq.'this is the value','value is set to:',value)
   !! REMOVE
   call system_unsetenv('NOT_THERE_S_U',ierr)
   call unit_check('system_unsetenv',ierr.eq.0,'should be zero ierr=',ierr)
   !! CHECK IF GONE
   call get_environment_variable("NOT_THERE_S_U", value=value,status=ierr)
   call unit_check('system_unsetenv',ierr.eq.1,'should be zero ierr=',ierr)
   call unit_check('system_unsetenv',value.eq.' ','value should be blank=',value)

   call unit_check_done('system_unsetenv',msg='')

end subroutine test_system_unsetenv
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_memcpy()
   call unit_check_start('system_memcpy',msg='')
   !!call unit_check('system_memcpy', 0.eq.0, 'checking',100)
   call unit_check_done('system_memcpy',msg='')
end subroutine test_system_memcpy
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_utime()
character(len=4096) :: pathname
integer             :: times(2)
integer             :: i
   call unit_check_start('system_utime',msg='')
   do i=1,command_argument_count()
      call get_command_argument(i, pathname)
      if(.not.system_utime(pathname,times))then
         call system_perror('*test_system_utime*')
      endif
   enddo
   !!call unit_check('system_utime', 0.eq.0, 'checking',100)
   call unit_check_done('system_utime',msg='')
end subroutine test_system_utime
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_system_dir()

   call unit_check_start('system_dir',msg='')
   !!call unit_check('system_dir', 0.eq.0, 'checking',100)
   call unit_check_done('system_dir',msg='')
end subroutine test_system_dir
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
end subroutine test_suite_M_system_tests