From febbddd36ab78168931af41d352a163093e4af8e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Nov 2023 15:59:00 +0100 Subject: [PATCH] starting to test system_routines --- src/materialpoint.f90 | 4 ++- src/system_routines.f90 | 42 +++++++++++++++++++++++++++++++ src/test/DAMASK_test.f90 | 7 +++++- src/test/test_system_routines.f90 | 17 +++++++++++++ 4 files changed, 68 insertions(+), 2 deletions(-) create mode 100644 src/test/test_system_routines.f90 diff --git a/src/materialpoint.f90 b/src/materialpoint.f90 index b92559a72..808cec146 100644 --- a/src/materialpoint.f90 +++ b/src/materialpoint.f90 @@ -5,8 +5,9 @@ !-------------------------------------------------------------------------------------------------- module materialpoint use parallelization - use signal use CLI + use system_routines + use signal use prec use misc use IO @@ -46,6 +47,7 @@ subroutine materialpoint_initAll() call parallelization_init() call CLI_init() ! grid and mesh commandline interface + call system_routines_init() call signal_init() call prec_init() call misc_init() diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 5207b5b94..aa4a140d6 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -6,11 +6,14 @@ module system_routines use, intrinsic :: ISO_C_Binding use prec + use IO implicit none(type,external) private public :: & + system_routines_init, & + system_routines_selfTest, & setCWD, & getCWD, & getHostName, & @@ -93,6 +96,18 @@ module system_routines 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. !-------------------------------------------------------------------------------------------------- @@ -103,6 +118,8 @@ logical function setCWD(path) setCWD = setCWD_C(f_c_string(path)) /= 0_C_INT + call system_routines_selfTest() + end function setCWD @@ -212,5 +229,30 @@ pure function f_c_string(f_string) result(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 diff --git a/src/test/DAMASK_test.f90 b/src/test/DAMASK_test.f90 index e2566be85..7b35174e1 100644 --- a/src/test/DAMASK_test.f90 +++ b/src/test/DAMASK_test.f90 @@ -5,6 +5,7 @@ program DAMASK_test use IO use test_prec + use test_system_routines use test_misc use test_math use test_polynomials @@ -19,7 +20,7 @@ program DAMASK_test character(len=*), parameter :: & ok = achar(27)//'[32mok'//achar(27)//'[0m', & - fmt = '(3x,a,T19,a,1x)' + fmt = '(3x,a,T20,a,1x)' call parallelization_init() call HDF5_utilities_init() @@ -34,6 +35,10 @@ program DAMASK_test call test_misc_run() 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','...' call test_math_run() write(IO_STDOUT,fmt='(a)') ok diff --git a/src/test/test_system_routines.f90 b/src/test/test_system_routines.f90 new file mode 100644 index 000000000..6c1996be4 --- /dev/null +++ b/src/test/test_system_routines.f90 @@ -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