starting to test system_routines

This commit is contained in:
Martin Diehl 2023-11-25 15:59:00 +01:00
parent 665e2d5b38
commit febbddd36a
4 changed files with 68 additions and 2 deletions

View File

@ -5,8 +5,9 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module materialpoint module materialpoint
use parallelization use parallelization
use signal
use CLI use CLI
use system_routines
use signal
use prec use prec
use misc use misc
use IO use IO
@ -46,6 +47,7 @@ subroutine materialpoint_initAll()
call parallelization_init() call parallelization_init()
call CLI_init() ! grid and mesh commandline interface call CLI_init() ! grid and mesh commandline interface
call system_routines_init()
call signal_init() call signal_init()
call prec_init() call prec_init()
call misc_init() call misc_init()

View File

@ -6,11 +6,14 @@ module system_routines
use, intrinsic :: ISO_C_Binding use, intrinsic :: ISO_C_Binding
use prec use prec
use IO
implicit none(type,external) implicit none(type,external)
private private
public :: & public :: &
system_routines_init, &
system_routines_selfTest, &
setCWD, & setCWD, &
getCWD, & getCWD, &
getHostName, & getHostName, &
@ -93,6 +96,18 @@ module system_routines
contains contains
!--------------------------------------------------------------------------------------------------
!> @brief Do self test.
!--------------------------------------------------------------------------------------------------
subroutine system_routines_init()
print'(/,1x,a)', '<<<+- system_routines init -+>>>'; flush(IO_STDOUT)
call system_routines_selfTest()
end subroutine system_routines_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Set the current working directory. !> @brief Set the current working directory.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -103,6 +118,8 @@ logical function setCWD(path)
setCWD = setCWD_C(f_c_string(path)) /= 0_C_INT setCWD = setCWD_C(f_c_string(path)) /= 0_C_INT
call system_routines_selfTest()
end function setCWD end function setCWD
@ -212,5 +229,30 @@ pure function f_c_string(f_string) result(c_string)
end function f_c_string end function f_c_string
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some system_routine functions.
!--------------------------------------------------------------------------------------------------
subroutine system_routines_selfTest()
real :: r
real, dimension(:), allocatable :: rnd_real
character(len=:), allocatable :: rnd_str
integer :: i
call random_number(r)
allocate(rnd_real(30+int(r*50.)))
call random_number(rnd_real)
allocate(character(size(rnd_real))::rnd_str)
do i = 1, size(rnd_real)
rnd_str(i:i) = char(32 + int(rnd_real(i)*(127.-32.)))
end do
if (c_f_string(f_c_string(rnd_str)) /= rnd_str) error stop 'c_f_string/f_c_string'
end subroutine system_routines_selfTest
end module system_routines end module system_routines

View File

@ -5,6 +5,7 @@ program DAMASK_test
use IO use IO
use test_prec use test_prec
use test_system_routines
use test_misc use test_misc
use test_math use test_math
use test_polynomials use test_polynomials
@ -19,7 +20,7 @@ program DAMASK_test
character(len=*), parameter :: & character(len=*), parameter :: &
ok = achar(27)//'[32mok'//achar(27)//'[0m', & ok = achar(27)//'[32mok'//achar(27)//'[0m', &
fmt = '(3x,a,T19,a,1x)' fmt = '(3x,a,T20,a,1x)'
call parallelization_init() call parallelization_init()
call HDF5_utilities_init() call HDF5_utilities_init()
@ -34,6 +35,10 @@ program DAMASK_test
call test_misc_run() call test_misc_run()
write(IO_STDOUT,fmt='(a)') ok write(IO_STDOUT,fmt='(a)') ok
write(IO_STDOUT,fmt=fmt, advance='no') 'system_routines','...'
call test_system_routines_run()
write(IO_STDOUT,fmt='(a)') ok
write(IO_STDOUT,fmt=fmt, advance='no') 'math','...' write(IO_STDOUT,fmt=fmt, advance='no') 'math','...'
call test_math_run() call test_math_run()
write(IO_STDOUT,fmt='(a)') ok write(IO_STDOUT,fmt='(a)') ok

View File

@ -0,0 +1,17 @@
module test_system_routines
use system_routines
implicit none(type,external)
private
public :: test_system_routines_run
contains
subroutine test_system_routines_run()
call system_routines_selfTest()
end subroutine test_system_routines_run
end module test_system_routines