workaround LLVMFLang 64-bit timer bug

Author: scivision

CMakePresets.json

@@ -14,6 +14,16 @@
   "name": "multi", "inherits": "default",
   "displayName": "Ninja Multi-Config",
   "generator": "Ninja Multi-Config"
+},
+{
+  "name": "clang_gfortran", "inherits": "default",
+  "displayName": "Clang + GFortran",
+  "description": "Use Clang for C/C++ and GFortran for Fortran",
+  "cacheVariables": {
+    "CMAKE_C_COMPILER": "clang",
+    "CMAKE_CXX_COMPILER": "clang++",
+    "CMAKE_Fortran_COMPILER": "gfortran"
+  }
 }
 ],
 "buildPresets": [

test/sleep/CMakeLists.txt

@@ -1,5 +1,16 @@
 set_property(DIRECTORY PROPERTY LABELS sleep)
 
+add_executable(fortran_sleep ticks.f90)
+add_test(NAME Fortran_sleep COMMAND fortran_sleep)
+
+if(CMAKE_Fortran_COMPILER_ID STREQUAL "LLVMFlang")
+  set(bad_ticks true)
+else()
+  set(bad_ticks false)
+endif()
+
+set_property(TEST Fortran_sleep PROPERTY DISABLED ${bad_ticks})
+
 add_library(f_sleep OBJECT ${PROJECT_SOURCE_DIR}/src/sleep/sleep_std.f90)
 
 # not OBJECT so include propagates
@@ -25,8 +36,10 @@ if(WIN32)
 add_library(f_win_sleep OBJECT ${PROJECT_SOURCE_DIR}/src/sleep/reference/windows.f90)
 set_property(TARGET f_win_sleep PROPERTY Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include/windows)
 target_include_directories(f_win_sleep PUBLIC ${CMAKE_CURRENT_BINARY_DIR}/include/windows)
+
 add_executable(fortran_win_sleep test_sleep.f90)
 target_link_libraries(fortran_win_sleep PRIVATE f_win_sleep)
+
 add_test(NAME Fortran_win_sleep COMMAND fortran_win_sleep)
 
 endif()
@@ -36,15 +49,20 @@ if(NOT MSVC)
 add_library(f_micro_sleep OBJECT ${PROJECT_SOURCE_DIR}/src/sleep/reference/posix_usleep.f90)
 set_property(TARGET f_micro_sleep PROPERTY Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include/posix_usleep)
 target_include_directories(f_micro_sleep PUBLIC ${CMAKE_CURRENT_BINARY_DIR}/include/posix_usleep)
+
 add_executable(fortran_micro_sleep test_sleep.f90)
 target_link_libraries(fortran_micro_sleep PRIVATE f_micro_sleep)
+
 add_test(NAME Fortran_micro_sleep COMMAND fortran_micro_sleep)
 
+
 add_library(f_nano_sleep OBJECT ${PROJECT_SOURCE_DIR}/src/sleep/reference/posix_nanosleep.f90)
 set_property(TARGET f_nano_sleep PROPERTY Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include/posix_nanosleep)
 target_include_directories(f_nano_sleep PUBLIC ${CMAKE_CURRENT_BINARY_DIR}/include/posix_nanosleep)
+
 add_executable(fortran_nano_sleep test_sleep.f90)
 target_link_libraries(fortran_nano_sleep PRIVATE f_nano_sleep)
+
 add_test(NAME Fortran_nano_sleep COMMAND fortran_nano_sleep)
 set_property(TEST Fortran_nano_sleep PROPERTY DISABLED true)
 # this test is shaky. Fails on MinGW and macOS Apple Silicon. Best to use an auxiliary C function to interface with C struct.

test/sleep/test_sleep.f90

@@ -1,44 +1,58 @@
 program sleep_demo
+!! we relax this example to use 32-bit timers as Flang 20 currently has a bug with 64-bit timers where the tick rate is reported as 1/1000th the actual rate.
 
-use, intrinsic :: iso_fortran_env, only : int64, stderr => error_unit
+use, intrinsic :: iso_fortran_env, only : stderr => error_unit, compiler_version
 
 use sleep_std, only : sleep_ms
 
 implicit none
 
-integer :: ierr, millisec
-character(8) :: argv
-integer(int64) :: tic, toc, trate
+
+integer :: ierr, millisec, L
+character(:), allocatable :: argv
+integer :: tic, toc, trate, ticks
 real :: t_ms
 
 call system_clock(count_rate=trate)
 
+if (trate <= 0) error stop "system_clock count_rate indicates no clock available"
+print '(a, i0)', 'CPU tick rate (ticks/sec): ', trate
+
 millisec = 500
 if(command_argument_count() > 0) then
+
+  call get_command_argument(1, length=L)
+  allocate(character(L) :: argv)
   call get_command_argument(1, argv, status=ierr)
   if (ierr /= 0) error stop "please specify milliseconds to sleep"
-  read(argv, '(i6)') millisec
+  read(argv, '(i5)') millisec
 end if
 
 if (millisec <= 0) error stop "please specify positive milliseconds to sleep"
+if (millisec > 10000) error stop "please specify milliseconds to sleep less than 10000"
+
+print '(a, i0)', 'sleeping for (ms): ', millisec
 
 call system_clock(count=tic)
 call sleep_ms(millisec)
 call system_clock(count=toc)
 
-t_ms = real(toc-tic) * 1000. / real(trate)
+ticks = toc-tic
+t_ms = 1000 * real(ticks) / real(trate)
+
+print '(a, i0)', 'ticks slept: ', ticks
 
 if (t_ms < 0.5 * millisec) then
   !> slept less than half expected time
-  write(stderr, '(a, f9.6)') 'ERROR: measured sleep time too short (millisec): ', t_ms
+  write(stderr, *) 'ERROR: measured sleep time too short (millisec): ', t_ms
   error stop
 end if
 if (t_ms > 2 * millisec) then
   !> slept more than twice expected time
-  write(stderr, '(a, f9.6)') 'ERROR: measure sleep time too long (millisec): ', t_ms
+  write(stderr, *) 'ERROR: measure sleep time too long (millisec): ', t_ms
   error stop
 end if
 
-print '(A, F6.1)', 'OK: test_sleep: slept for (ms): ', t_ms
+print '(A, F7.1)', 'OK: ' // compiler_version() // ' slept for (ms): ', t_ms
 
 end program

test/sleep/ticks.f90

@@ -0,0 +1,45 @@
+program ticks
+
+use, intrinsic :: iso_fortran_env, only : int32, int64, error_unit
+
+implicit none
+
+integer(int32) :: trate32, tic32, toc32, ticks32
+integer(int64) :: trate, tic, toc, ticks64
+logical :: ok = .true.
+
+call system_clock(count_rate=trate)
+call system_clock(count_rate=trate32)
+
+if (trate <= 0) error stop "system_clock count_rate indicates no clock available"
+print '(a, i0)', 'CPU 64-bit tick rate (ticks/sec): ', trate
+print '(a, i0)', 'CPU 32-bit tick rate (ticks/sec): ', trate32
+
+call system_clock(count=tic)
+call system_clock(count=tic32)
+
+call sleep(1)
+! this is non-standard, but we are interested in tick counts
+
+call system_clock(count=toc)
+call system_clock(count=toc32)
+
+ticks64 = toc - tic
+ticks32 = toc32 - tic32
+print '(a,i0,a,i0)', 'CPU ticks: 64-bit ', ticks64, ' 32-bit ', ticks32
+
+if (real(ticks64) < real(trate) * 0.95 .or. real(ticks64) > real(trate) * 1.05) then
+  ok = .false.
+  write(error_unit, *) 'ERROR: 64-bit ticks: expected about ', trate, ' but got ', ticks64
+end if
+
+if (real(ticks32) < real(trate32) * 0.95 .or. real(ticks32) > real(trate32) * 1.05) then
+  ok = .false.
+  write(error_unit, *) 'ERROR: 32-bit ticks: expected about ', trate32, ' but got ', ticks32
+end if
+
+if (.not. ok) error stop "tick rate test failed"
+
+print *, 'OK: ticks: tick rates look good'
+
+end program