speedup f03 tests

cmake/f03abstract.cmake

@@ -1,8 +1,6 @@
-check_source_compiles(Fortran
-"program abst
-
-implicit none
+set(CMAKE_TRY_COMPILE_TARGET_TYPE STATIC_LIBRARY)
 
+check_source_compiles(Fortran "subroutine r()
 type, abstract :: L1
 integer, pointer :: bullseye(:,:)
 end type L1
@@ -13,7 +11,6 @@ end type L2
 
 class(L2), allocatable :: obj
 
-end program
-"
+end subroutine"
 f03abstract
 )

cmake/f03charalloc.cmake

@@ -1,11 +1,9 @@
-check_source_compiles(Fortran
-"program a
-implicit none
-character(:), allocatable :: x(:)
+set(CMAKE_TRY_COMPILE_TARGET_TYPE STATIC_LIBRARY)
 
+check_source_compiles(Fortran "subroutine r()
 character(:), allocatable :: flex(:), scalar
 
 flex = [character(5) :: 'hi', 'hello']
-end program"
+end subroutine"
 f03charalloc
 )

cmake/f03ieee.cmake

@@ -1,10 +1,8 @@
-check_source_compiles(Fortran
-"
-program a
+set(CMAKE_TRY_COMPILE_TARGET_TYPE STATIC_LIBRARY)
+
+check_source_compiles(Fortran "subroutine r()
 use, intrinsic :: ieee_arithmetic, only : ieee_next_after
-implicit none
-print *, ieee_next_after(0.,0.)
-end program
-"
+print *, ieee_next_after(0., 0.)
+end subroutine"
 f03ieee
 )

cmake/f03selectType.cmake

@@ -1,29 +1,16 @@
-check_source_compiles(Fortran
-"
-program selectType
-implicit none
-real :: r
-integer :: i
+set(CMAKE_TRY_COMPILE_TARGET_TYPE STATIC_LIBRARY)
 
-call selector(r)
-call selector(i)
-
-contains
-
-subroutine selector(x)
+check_source_compiles(Fortran "subroutine selector(x)
 
 class(*), intent(in) :: x
 
 select type (x)
   type is (real)
-    print *, 'real'
+    print '(a)', 'real'
   type is (integer)
-    print *, 'integer'
+    print '(a)', 'integer'
 end select
 
-end subroutine
-
-end program
-"
+end subroutine"
 f03selectType
 )

cmake/f03utf8.cmake

@@ -1,5 +1,8 @@
+set(CMAKE_TRY_COMPILE_TARGET_TYPE STATIC_LIBRARY)
+
 check_source_compiles(Fortran
 "program test
+intrinsic :: selected_char_kind
 character(kind=selected_char_kind('ISO_10646')) :: x
 end program"
 f03utf8

cmake/f18assumed_rank.cmake

@@ -1,17 +1,12 @@
-check_source_compiles(Fortran
-"
-program test
-implicit none
-contains
+set(CMAKE_TRY_COMPILE_TARGET_TYPE STATIC_LIBRARY)
 
-subroutine r(A)
+check_source_compiles(Fortran "subroutine r(A)
 integer, intent(inout) :: A(..)
 select rank(A)
   rank default
     error stop
 end select
 end subroutine r
-end program
 "
 f18assumed_rank
 )

src/system/call_python_script.f90

@@ -5,20 +5,26 @@ program call_python
 
 implicit none
 
-character(:), allocatable :: cmd
-character(1024) :: buf
-integer :: ierr, icerr
+character(:), allocatable :: cmd, buf
+integer :: ierr, icerr, L
+
+valgrind : block
 
 cmd = "import os; print(f'{os.cpu_count()} CPUs detected by Python')"
 
-call get_command_argument(1, buf, status=ierr)
+call get_command_argument(1, length=L, status=ierr)
 if (ierr /= 0) error stop "please specify Python interpreter as first argument"
+allocate(character(L) :: buf)
+call get_command_argument(1, value=buf)
 
-buf = trim(buf)//' -c "'//cmd//'"'
+buf = trim(buf) // ' -c "' // cmd // '"'
 
 print '(a)', trim(buf)
 
 call execute_command_line(buf, exitstat=ierr, cmdstat=icerr)
 if (icerr/=0) error stop "Python interpreter not runnable"
 if (ierr/=0) error stop "Python script failed"
+
+end block valgrind
+
 end program

src/system/os_detect.f90

@@ -6,14 +6,14 @@ module os_detect
 
 function getos()
 !! heuristic detection of operating system based on de facto environment variables
-character(256) :: buf
 character(:), allocatable :: getos
+integer :: L, i
 
-call get_environment_variable("HOME", buf)
-if (len_trim(buf) > 0) getos = "unix"
+call get_environment_variable("HOME", length=L, status=i)
+if (i == 0 .and. L > 0) getos = "unix"
 
-call get_environment_variable("USERPROFILE", buf)
-if (len_trim(buf) > 0) getos = "windows"
+call get_environment_variable("USERPROFILE", length=L, status=i)
+if (i == 0 .and. L > 0) getos = "windows"
 
 end function getos
 

src/system/play_sound.f90

@@ -9,23 +9,27 @@ program play_sound
 ! -autoexit clips off the end of the sound slightly, but otherwise thread hangs open even after Fortran program ends.
 character(*),parameter :: cmdopts='-autoexit -loglevel warning -nodisp'
 
-character(:), allocatable :: fn, pcmd
-character(2048) :: argv
+character(:), allocatable :: pcmd, buf
 logical :: fexist
-integer :: ierr, istat
+integer :: ierr, istat, L
 
-call get_command_argument(1, argv, status=ierr)
-if (ierr /= 0) error stop 'please include audio filename in command'
-fn = trim(argv)
+valgrind : block
 
-inquire(file=fn, exist=fexist)
+call get_command_argument(1, length=L, status=ierr)
+if (ierr /= 0) error stop "please specify sound file"
+allocate(character(L) :: buf)
+call get_command_argument(1, value=buf)
 
-if (.not. fexist) error stop 'did not find FILE ' // fn
+inquire(file=buf, exist=fexist)
 
-pcmd = playexe//' '//cmdopts//' '//trim(fn)
+if (.not. fexist) error stop 'did not find FILE ' // buf
+
+pcmd = playexe//' '//cmdopts//' '//trim(buf)
 
 call execute_command_line(pcmd, cmdstat=ierr, exitstat=istat)
 if(ierr /= 0) error stop 'could not open player'
 if(istat /= 0) error stop 'problem playing file'
 
+end block valgrind
+
 end program

test/character/character_allocatable.f90

@@ -5,6 +5,8 @@ program character_alloctable
 
 character(:), allocatable :: flex(:), scalar
 
+valgrind : block
+
 scalar = 'hi'
 if (len(scalar) /= 2) error stop 'auto-alloc char scalar'
 scalar = 'hello'
@@ -35,6 +37,7 @@ program character_alloctable
 if (flex(1) /= 'hi') error stop "flex: flex(1) /= 'hi'"
 if (flex(2) /= 'bye') error stop "flex: flex(2) /= 'bye'"
 
+end block valgrind
 
 print *, "OK: allocatable character"
 

test/character/str2int.f90

@@ -7,7 +7,7 @@ program str2int_demo
 
 x = '42'
 m = str2int(x)
-if (m/=42) error stop
+if (m /= 42) error stop
 
 contains
 

test/character/test_string.f90

@@ -17,10 +17,10 @@ program test_string
 subroutine test_split()
 
 
-character(*),parameter :: mystr="hello.txt"
-character(:),allocatable :: stem
+character(*), parameter :: mystr = "hello.txt"
+character(:), allocatable :: stem
 
-stem = split(mystr,'.')
+stem = split(mystr, '.')
 print '(A)', stem
 
 if (len(stem) /= 5) error stop 'allocatable character of unexpected length'
@@ -33,9 +33,9 @@ subroutine test_lowercase()
 character(*), parameter :: hello = 'HeLl0 Th3rE !>? '
   !! Fortran 2003 allocatable string
 
-if (.not.(toLower(hello)=='hell0 th3re !>? ')) error stop 'error: lowercase conversion'
+if (.not.(toLower(hello) == 'hell0 th3re !>? ')) error stop 'error: lowercase conversion'
 
-if (.not.(trim(toLower(hello))=='hell0 th3re !>?')) error stop 'Allocatable lowercase conversion error'
+if (.not.(trim(toLower(hello)) == 'hell0 th3re !>?')) error stop 'Allocatable lowercase conversion error'
 
 end subroutine test_lowercase
 

test/character/utf8.f90

@@ -9,9 +9,12 @@ program utf8_char
 character(len=:, kind=selected_char_kind('ISO_10646')), allocatable :: utf8
 
 ascii = '☀ ☁ ☂ ☃ ☄'
-utf8 = '☀ ☁ ☂ ☃ ☄'
+utf8  = '☀ ☁ ☂ ☃ ☄'
 
-print *, 'ascii', ascii, ' some compilers allow UTF-8 to be packed into ASCII per Fortran 2003 standard (optional)'
-print *, 'utf8', utf8, ' this is 4-byte characters.'
+print '(a)', 'ASCII:'
+print '(a)', ascii
+
+print '(a)', 'UCS4:'
+print '(a)', utf8
 
 end program

test/io/devnull.f90

@@ -19,19 +19,19 @@ program devnull
 ! making mistakes in doing so.
 !
 !
-character(*),parameter :: fout='out.txt'
+character(*), parameter :: fout='out.txt'
 character(:), allocatable :: nullfile
 character(2048) :: argv
 integer,parameter :: Nrun=10000
-integer :: ios,u
+integer :: ios,u, L
 real(wp) :: tnul, tscratch, tfile
 
 call get_command_argument(1, argv, status=ios)
 if (ios == 0) then
   nullfile = trim(argv)
 else
-  call get_environment_variable('userprofile', status=ios)
-  if (ios==0) then
+  call get_environment_variable('userprofile', status=ios, length=L)
+  if (ios==0 .and. L > 0) then
     nullfile = 'NUL'
   else
     nullfile = '/dev/null'
@@ -40,38 +40,38 @@ program devnull
 
 !---  BENCHMARK NUL -----------
 ! do NOT use status='old' as this can fail on various OS
-open(newunit=u, file=nullfile,iostat=ios, action='write')
+open(newunit=u, file=nullfile, iostat=ios, action='write')
 if (ios /= 0) error stop 'could not open NULL file: ' // nullfile
 
-tnul = writetime(u,Nrun)
-print '(A10,F10.3,A)','nul: ',tnul,' ms'
+tnul = writetime(u, Nrun)
+print '(A10,F10.3,A)', 'nul: ', tnul, ' ms'
 !---- BENCHMARK SCRATCH --------------
-open(newunit=u,status='scratch')
-tscratch = writetime(u,Nrun)
-print '(A10,F10.3,A)','scratch: ',tscratch,' ms'
+open(newunit=u, status='scratch')
+tscratch = writetime(u, Nrun)
+print '(A10,F10.3,A)', 'scratch: ', tscratch, ' ms'
 !---- BENCHMARK FILE --------
 ! note that open() default position=asis, access=sequential
-open(newunit=u,status='replace',file=fout)
-tfile = writetime(u,Nrun)
-print '(A10,F10.3,A)','file: ',tfile,' ms'
+open(newunit=u, status='replace', file=fout)
+tfile = writetime(u, Nrun)
+print '(A10,F10.3,A)','file: ', tfile, ' ms'
 
 
 contains
 
-real(wp) function writetime(u,Nrun)
+real(wp) function writetime(u, Nrun)
 
-  integer, intent(in) :: u,Nrun
+  integer, intent(in) :: u, Nrun
   integer(int64) :: tic,toc,tmin, rate
   integer, volatile :: i
   integer j
 
-  tmin  = huge(0_int64) ! need to avoid SAVE behavior by not assigning at initialization
+  tmin = huge(0_int64) ! need to avoid SAVE behavior by not assigning at initialization
   call system_clock(count_rate=rate)
 
   do j=1,3
     call system_clock(tic)
     do i=1,Nrun
-      write(u,*) 'into nothingness I go....',i
+      write(u, '(a,i0)') 'into nothingness I go....', i
       flush(u)
     enddo
     call system_clock(toc)