starting to test system_routines

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()

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
 

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

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