Merge pull request #54 from scivision/systemlib

add system module

Author: milancurcic

README.md

@@ -1,5 +1,9 @@
 # Fortran Standard Library
 
+[![Actions Status](https://github.com/fortran-lang/stdlib/workflows/CI/badge.svg)](https://github.com/fortran-lang/stdlib/actions)
+[![Actions Status](https://github.com/fortran-lang/stdlib/workflows/CI_windows/badge.svg)](https://github.com/fortran-lang/stdlib/actions)
+
+
 ## Goals and Motivation
 
 The Fortran Standard, as published by the ISO (https://wg5-fortran.org/), does
@@ -31,19 +35,19 @@ The goal of the Fortran Standard Library is to achieve the following general sco
 
 ### Get the code
 
-```
+```sh
 git clone https://github.com/fortran-lang/stdlib
 cd stdlib
 ```
 
 ### Build with CMake
 
-```
-mkdir build
-cd build
-cmake ..
-make
-ctest
+```sh
+cmake -B build
+
+cmake --build build
+
+cmake --build build --target test
 ```
 
 ### Build with make

src/CMakeLists.txt

@@ -2,8 +2,9 @@ set(SRC
     stdlib_experimental_ascii.f90
     stdlib_experimental_io.f90
     stdlib_experimental_error.f90
-    stdlib_experimental_optval.f90
     stdlib_experimental_kinds.f90
+    stdlib_experimental_optval.f90
+    stdlib_experimental_system.F90
 )
 
 add_library(fortran_stdlib ${SRC})

src/stdlib_experimental_system.F90

@@ -0,0 +1,43 @@
+module stdlib_experimental_system
+use, intrinsic :: iso_c_binding, only : c_int, c_long
+implicit none
+private
+public :: sleep
+
+interface
+#ifdef _WIN32
+subroutine winsleep(dwMilliseconds) bind (C, name='Sleep')
+!! void Sleep(DWORD dwMilliseconds)
+!! https://docs.microsoft.com/en-us/windows/win32/api/synchapi/nf-synchapi-sleep
+import c_long
+integer(c_long), value, intent(in) :: dwMilliseconds
+end subroutine winsleep
+#else
+integer(c_int) function usleep(usec) bind (C)
+!! int usleep(useconds_t usec);
+!! https://linux.die.net/man/3/usleep
+import c_int
+integer(c_int), value, intent(in) :: usec
+end function usleep
+#endif
+end interface
+
+contains
+
+subroutine sleep(millisec)
+integer, intent(in) :: millisec
+integer(c_int) :: ierr
+
+#ifdef _WIN32
+!! PGI Windows, Ifort Windows, ....
+call winsleep(int(millisec, c_long))
+#else
+!! Linux, Unix, MacOS, MSYS2, ...
+ierr = usleep(int(millisec * 1000, c_int))
+if (ierr/=0) error stop 'problem with usleep() system call'
+#endif
+
+
+end subroutine sleep
+
+end module stdlib_experimental_system

src/tests/CMakeLists.txt

@@ -9,6 +9,7 @@ endmacro(ADDTEST)
 add_subdirectory(ascii)
 add_subdirectory(io)
 add_subdirectory(optval)
+add_subdirectory(system)
 
 ADDTEST(always_skip)
 set_tests_properties(always_skip PROPERTIES SKIP_RETURN_CODE 77)

src/tests/system/CMakeLists.txt

@@ -0,0 +1,5 @@
+add_executable(test_sleep test_sleep.f90)
+target_link_libraries(test_sleep fortran_stdlib)
+
+add_test(NAME Sleep COMMAND $<TARGET_FILE:test_sleep> 350)
+set_tests_properties(Sleep PROPERTIES TIMEOUT 1)

src/tests/system/test_sleep.f90

@@ -0,0 +1,33 @@
+program test_sleep
+use, intrinsic :: iso_fortran_env, only : int64, real64
+use stdlib_experimental_system, only : sleep
+
+implicit none
+
+integer :: ierr, millisec
+character(8) :: argv
+integer(int64) :: tic, toc, trate
+real(real64) :: t_ms
+
+call system_clock(count_rate=trate)
+
+millisec = 780
+call get_command_argument(1, argv, status=ierr)
+if (ierr==0) read(argv,*) millisec
+
+if (millisec<0) millisec=0
+
+call system_clock(count=tic)
+call sleep(millisec)
+call system_clock(count=toc)
+
+t_ms = (toc-tic) * 1000._real64 / trate
+
+if (millisec > 0) then
+  if (t_ms < 0.5 * millisec) error stop 'actual sleep time was too short'
+  if (t_ms > 2 * millisec) error stop 'actual sleep time was too long'
+endif
+
+print '(A,F8.3)', 'OK: test_sleep: slept for (ms): ',t_ms
+
+end program