|
1 |
| -program test_sleep |
2 |
| -use, intrinsic :: iso_fortran_env, only : int64, real64 |
3 |
| -use stdlib_system, only : sleep |
| 1 | +module test_sleep |
| 2 | + use, intrinsic :: iso_fortran_env, only : int64, real64 |
| 3 | + use stdlib_system, only : sleep |
| 4 | + use stdlib_test, only: new_unittest, unittest_type, error_type, check |
| 5 | + implicit none |
4 | 6 |
|
5 |
| -implicit none |
| 7 | + private |
| 8 | + public :: collect_sleep |
6 | 9 |
|
7 |
| -integer :: ierr, millisec |
8 |
| -character(8) :: argv |
9 |
| -integer(int64) :: tic, toc, trate |
10 |
| -real(real64) :: t_ms |
| 10 | + integer, parameter :: millisec = 100 |
11 | 11 |
|
12 |
| -call system_clock(count_rate=trate) |
| 12 | +contains |
13 | 13 |
|
14 |
| -millisec = 780 |
15 |
| -call get_command_argument(1, argv, status=ierr) |
16 |
| -if (ierr==0) read(argv,*) millisec |
| 14 | + !> Collect all exported unit tests |
| 15 | + subroutine collect_sleep(testsuite) |
| 16 | + !> Collection of tests |
| 17 | + type(unittest_type), allocatable, intent(out) :: testsuite(:) |
17 | 18 |
|
18 |
| -if (millisec<0) millisec=0 |
| 19 | + testsuite = [ & |
| 20 | + new_unittest('sleep', test_sleep_) & |
| 21 | + ] |
19 | 22 |
|
20 |
| -call system_clock(count=tic) |
21 |
| -call sleep(millisec) |
22 |
| -call system_clock(count=toc) |
| 23 | + end subroutine collect_sleep |
23 | 24 |
|
24 |
| -t_ms = (toc-tic) * 1000._real64 / trate |
25 | 25 |
|
26 |
| -if (millisec > 0) then |
27 |
| - if (t_ms < 0.5 * millisec) error stop 'actual sleep time was too short' |
28 |
| - if (t_ms > 2 * millisec) error stop 'actual sleep time was too long' |
29 |
| -endif |
| 26 | + subroutine test_sleep_(error) |
| 27 | + !> Error handling |
| 28 | + type(error_type), allocatable, intent(out) :: error |
30 | 29 |
|
31 |
| -print '(A,F8.3)', 'OK: test_sleep: slept for (ms): ',t_ms |
| 30 | + integer(int64) :: tic, toc, trate |
| 31 | + real(real64) :: t_ms |
32 | 32 |
|
33 |
| -end program |
| 33 | + call system_clock(count_rate=trate) |
| 34 | + |
| 35 | + call system_clock(count=tic) |
| 36 | + call sleep(millisec) |
| 37 | + call system_clock(count=toc) |
| 38 | + |
| 39 | + t_ms = (toc - tic) * 1000._real64 / trate |
| 40 | + |
| 41 | + call check(error, t_ms > 0.5 * millisec) |
| 42 | + call check(error, t_ms < 2 * millisec) |
| 43 | + |
| 44 | + end subroutine test_sleep_ |
| 45 | + |
| 46 | +end module test_sleep |
| 47 | + |
| 48 | + |
| 49 | +program tester |
| 50 | + use, intrinsic :: iso_fortran_env, only: error_unit |
| 51 | + use stdlib_test, only: run_testsuite, new_testsuite, testsuite_type |
| 52 | + use test_sleep, only: collect_sleep |
| 53 | + implicit none |
| 54 | + integer :: stat, is |
| 55 | + type(testsuite_type), allocatable :: testsuites(:) |
| 56 | + character(len=*), parameter :: fmt = '("#", *(1x, a))' |
| 57 | + |
| 58 | + stat = 0 |
| 59 | + |
| 60 | + testsuites = [ & |
| 61 | + new_testsuite('sleep', collect_sleep) & |
| 62 | + ] |
| 63 | + |
| 64 | + do is = 1, size(testsuites) |
| 65 | + write(error_unit, fmt) "Testing:", testsuites(is)%name |
| 66 | + call run_testsuite(testsuites(is)%collect, error_unit, stat) |
| 67 | + end do |
| 68 | + |
| 69 | + if (stat > 0) then |
| 70 | + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" |
| 71 | + error stop |
| 72 | + end if |
| 73 | + |
| 74 | +end program tester |
0 commit comments