diff --git a/README.md b/README.md index 27c43c599..ed29e2350 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,9 @@ # Fortran Standard Library +[](https://github.com/fortran-lang/stdlib/actions) +[](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 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ee5a7aa22..72b3d25cd 100644 --- a/src/CMakeLists.txt +++ b/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}) diff --git a/src/stdlib_experimental_system.F90 b/src/stdlib_experimental_system.F90 new file mode 100644 index 000000000..3f6bf7fdc --- /dev/null +++ b/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 \ No newline at end of file diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index dc1bdbc96..e72592579 100644 --- a/src/tests/CMakeLists.txt +++ b/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) diff --git a/src/tests/system/CMakeLists.txt b/src/tests/system/CMakeLists.txt new file mode 100644 index 000000000..68acc08d4 --- /dev/null +++ b/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) \ No newline at end of file diff --git a/src/tests/system/test_sleep.f90 b/src/tests/system/test_sleep.f90 new file mode 100644 index 000000000..f17182fa6 --- /dev/null +++ b/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 \ No newline at end of file