Skip to content

Commit

Permalink
Merge pull request #54 from scivision/systemlib
Browse files Browse the repository at this point in the history
add system module
  • Loading branch information
milancurcic authored Jan 8, 2020
2 parents 12bd060 + 0ea0ee1 commit f300f4a
Show file tree
Hide file tree
Showing 6 changed files with 95 additions and 8 deletions.
18 changes: 11 additions & 7 deletions README.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion src/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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})
Expand Down
43 changes: 43 additions & 0 deletions src/stdlib_experimental_system.F90
Original file line number Diff line number Diff line change
@@ -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
1 change: 1 addition & 0 deletions src/tests/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
5 changes: 5 additions & 0 deletions src/tests/system/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -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)
33 changes: 33 additions & 0 deletions src/tests/system/test_sleep.f90
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit f300f4a

Please sign in to comment.