Skip to content

Commit 1e29bdb

Browse files
committed
Port test_sleep to test-drive
1 parent 548b8a2 commit 1e29bdb

File tree

2 files changed

+65
-28
lines changed

2 files changed

+65
-28
lines changed

src/tests/system/CMakeLists.txt

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1 @@
1-
add_executable(test_sleep test_sleep.f90)
2-
target_link_libraries(test_sleep ${PROJECT_NAME})
3-
4-
add_test(NAME Sleep COMMAND $<TARGET_FILE:test_sleep> 350)
5-
set_tests_properties(Sleep PROPERTIES TIMEOUT 1)
1+
ADDTEST(sleep)

src/tests/system/test_sleep.f90

Lines changed: 64 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,33 +1,74 @@
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
46

5-
implicit none
7+
private
8+
public :: collect_sleep
69

7-
integer :: ierr, millisec
8-
character(8) :: argv
9-
integer(int64) :: tic, toc, trate
10-
real(real64) :: t_ms
10+
integer, parameter :: millisec = 100
1111

12-
call system_clock(count_rate=trate)
12+
contains
1313

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

18-
if (millisec<0) millisec=0
19+
testsuite = [ &
20+
new_unittest('sleep', test_sleep_) &
21+
]
1922

20-
call system_clock(count=tic)
21-
call sleep(millisec)
22-
call system_clock(count=toc)
23+
end subroutine collect_sleep
2324

24-
t_ms = (toc-tic) * 1000._real64 / trate
2525

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
3029

31-
print '(A,F8.3)', 'OK: test_sleep: slept for (ms): ',t_ms
30+
integer(int64) :: tic, toc, trate
31+
real(real64) :: t_ms
3232

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

Comments
 (0)