use fortran 2018 error stop

scivision · scivision · commit 00d7127a6eae · 2020-10-19T14:23:12.000-04:00
diff --git a/.archive/.appveyor.yml b/.archive/.appveyor.yml
diff --git a/.archive/.travis.yml b/.archive/.travis.yml
diff --git a/.archive/azure-pipelines.yml b/.archive/azure-pipelines.yml
diff --git a/.archive/build.py b/.archive/build.py
diff --git a/.archive/mkdir.F90 b/.archive/mkdir.F90
@@ -1,9 +1,8 @@
 module std_mkdir
 !! C binding to C-stdlib mkdir()
 use, intrinsic:: iso_c_binding, only: c_int, c_char, C_NULL_CHAR
-use, intrinsic:: iso_fortran_env, only: stderr=>error_unit
 
-implicit none
+implicit none (type, external)
 
 logical, parameter :: debug = .false.
 
@@ -94,7 +93,7 @@ end module std_mkdir
 program test_mkdir
 !! just for testing
 use std_mkdir
-implicit none
+implicit none (type, external)
 
 !> demo
 character(4096) :: buf
@@ -115,8 +114,6 @@ program test_mkdir
 close(u)
 
 inquire(file=fpath, exist=exists)
-if(.not.exists) then
-  write(stderr,*) fpath // ' failed to be created'
-  error stop
-endif
+if(.not.exists) error stop fpath // ' failed to be created'
+
 end program
diff --git a/.archive/mkl.cmake b/.archive/mkl.cmake
diff --git a/.archive/pi2008.f90 b/.archive/pi2008.f90
@@ -1,7 +1,8 @@
+program pi2008
 !! implements calculation:
 !! $$ \pi = \int^1_{-1} \frac{dx}{\sqrt{1-x^2}}
 
-use, intrinsic:: iso_fortran_env, only: dp=>real64, int64, stderr=>error_unit
+use, intrinsic:: iso_fortran_env, only: dp=>real64, int64
 implicit none
 
 integer, parameter :: wp = dp
@@ -62,4 +63,4 @@
   print '(A,E10.3,A,I3,A)', 'Elapsed wall clock time ', telaps, ' seconds, using',num_images(),' images.'
 end if
 
-end program
+end program
diff --git a/character/test_string.f90 b/character/test_string.f90
@@ -1,6 +1,5 @@
 program test_string
 
-use, intrinsic:: iso_fortran_env, only:  stderr=>error_unit
 use, intrinsic:: iso_c_binding, only: c_null_char
 use string_utils
 
diff --git a/cmake/f18errorstop.cmake b/cmake/f18errorstop.cmake
@@ -1 +1,4 @@
 check_fortran_source_compiles("character :: x; error stop x; end" f18errorstop SRC_EXT f90)
+if(NOT f18errorstop)
+  message(FATAL_ERROR "Fortran 2018 error stop is used throughout.")
+endif()
diff --git a/coarray/pi.f90 b/coarray/pi.f90
@@ -2,7 +2,7 @@ program test_pi
 !! implements calculation:
 !! $$ \pi = \int^1_{-1} \frac{dx}{\sqrt{1-x^2}}
 
-use, intrinsic:: iso_fortran_env, only: dp=>real64, int64, stderr=>error_unit
+use, intrinsic:: iso_fortran_env, only: dp=>real64, int64
 implicit none (type, external)
 
 integer, parameter :: wp = dp
@@ -42,11 +42,7 @@ program test_pi
 !  print *,x,f,psum
 end do
 
-call co_sum(psum, stat=ierr)
-if (ierr /= 0) then
-  write(stderr,*) 'error stop', ierr
-  error stop
-endif
+call co_sum(psum)
 
 if (im == 1)  then
   print *,'pi:',pi,'  iterated pi: ',psum
diff --git a/git/CMakeLists.txt b/git/CMakeLists.txt
@@ -7,10 +7,12 @@ execute_process(COMMAND ${GIT_EXECUTABLE} rev-parse --abbrev-ref HEAD
 OUTPUT_VARIABLE git_branch OUTPUT_STRIP_TRAILING_WHITESPACE)
 execute_process(COMMAND ${GIT_EXECUTABLE} rev-parse --short HEAD
 OUTPUT_VARIABLE git_rev OUTPUT_STRIP_TRAILING_WHITESPACE)
+
 execute_process(COMMAND ${GIT_EXECUTABLE} status --porcelain
 OUTPUT_VARIABLE git_porcelain OUTPUT_STRIP_TRAILING_WHITESPACE)
+set(git_porcelain .true.)
 if(git_porcelain)
-string(REGEX REPLACE "\n" " " git_porcelain ${git_porcelain})
+  set(git_porcelain .false.)
 endif(git_porcelain)
 else()
 set(git_branch)
diff --git a/git/main.in.f90 b/git/main.in.f90
@@ -1,17 +1,16 @@
 program git_demo
-
+!! we don't make porcelain a character because it could go beyond max fortran line length
 implicit none (type, external)
 
-character(:), allocatable :: git_version, branch, rev, porcelain
+character(:), allocatable :: git_version, branch, rev
+logical :: porcelain
 
 git_version = "@git_version@"
 branch = "@git_branch@"
 rev = "@git_rev@"
-porcelain = "@git_porcelain@"
-
-print *, "MyProgram  git_version:", git_version, " git_branch: ", branch, " git revision: ", rev
+porcelain = @git_porcelain@
 
-if (len(porcelain) > 0) print *, " git_porcelain:", porcelain
+print *, "MyProgram  git_version:", git_version, " git_branch: ", branch, " git revision: ", rev, 'git_porcelain', porcelain
 !! could also use this to set a warning or other logical flag
 
 end program
diff --git a/io/devnull.f90 b/io/devnull.f90
@@ -1,4 +1,5 @@
-use, intrinsic:: iso_fortran_env, only: int64, wp=>real64, stderr=>error_unit
+program devnull
+use, intrinsic:: iso_fortran_env, only: int64, wp=>real64
 implicit none (type, external)
 ! Benchmarks platform independent null file writing behavior
 ! NUL: works on Windows 10
@@ -40,10 +41,7 @@
 !---  BENCHMARK NUL -----------
 ! do NOT use status='old' as this can fail on various OS, compiler including PGI + Windows
 open(newunit=u,file=nullfile,iostat=ios, action='write')
-if (ios /= 0) then
-  write(stderr,*) 'could not open NULL file: ' // nullfile
-  error stop
-endif
+if (ios /= 0) error stop 'could not open NULL file: ' // nullfile
 
 tnul = writetime(u,Nrun)
 print '(A10,F10.3,A)','nul: ',tnul,' ms'
diff --git a/io/fileopen-readonly.f90 b/io/fileopen-readonly.f90
@@ -1,7 +1,6 @@
 program open_ro
 !! NOTE: chmod is non-standard, and will crash ifort runtime.
 
-use, intrinsic :: iso_fortran_env, only: stderr=>error_unit
 use pathlib, only : unlink
 
 implicit none (type, external)
diff --git a/io/fullpath_windows.f90 b/io/fullpath_windows.f90
@@ -55,28 +55,21 @@ end module canonical
 
 program demo
 
-use, intrinsic :: iso_fortran_env, only : stderr=>error_unit
 use canonical, only : realpath
 
-implicit none
+implicit none (type, external)
 
 character(:), allocatable :: canon
 
 ! -- test directory
 canon = realpath('..')
 
-if (len_trim(canon) < 20) then
-  write(stderr,*) 'ERROR: directory ' // canon // ' was not canonicalized '
-  error stop
-endif
+if (len_trim(canon) < 20) error stop 'ERROR: directory ' // canon // ' was not canonicalized '
 
 ! -- test file
 canon = realpath('../foo.txt')
 
-if (len_trim(canon) < 28) then
-  write(stderr,*) 'ERROR: file ' // canon // ' was not canonicalized '
-  error stop
-endif
+if (len_trim(canon) < 28) error stop 'ERROR: file ' // canon // ' was not canonicalized '
 
 print *, canon
 
diff --git a/io/pathlib.in.f90 b/io/pathlib.in.f90
@@ -142,7 +142,7 @@ function home()
 
 if (L==0 .or. istat /= 0) then
   write(stderr,*) 'ERROR: could not determine home directory from env variable'
-  if (istat==1) write(stderr,*) 'env variable does not exist.'
+  if (istat==1) write(stderr,*) 'environment variable does not exist.'
   home = ""
 else
   home = trim(buf) // '/'
diff --git a/io/realpath_cxx.f90 b/io/realpath_cxx.f90
@@ -44,19 +44,15 @@ end module abspath
 
 program demo
 
-use, intrinsic :: iso_fortran_env, only : stderr=>error_unit
 use abspath, only : realpath
 
-implicit none
+implicit none (type, external)
 
 character(*), parameter :: rel = '..'
 character(:), allocatable :: canon
 
 canon = realpath(rel)
 
-if (canon == rel) then
-  write(stderr,*) rel // ' was not canonicalized ' // canon
-  error stop
-endif
+if (canon == rel) error stop rel // ' was not canonicalized ' // canon
 
 end program
diff --git a/io/realpath_posix.f90 b/io/realpath_posix.f90
@@ -51,7 +51,6 @@ end module canonical
 
 program demo
 
-use, intrinsic :: iso_fortran_env, only : stderr=>error_unit
 use canonical, only : realpath
 
 implicit none
@@ -63,21 +62,15 @@ program demo
 ! -- test directory
 canon = realpath('..')
 
-if (len_trim(canon) < 20) then
-  write(stderr,*) 'ERROR: directory ' // canon // ' was not canonicalized '
-  error stop
-endif
+if (len_trim(canon) < 20) error stop 'ERROR: directory ' // canon // ' was not canonicalized.'
 
 ! -- test
 inquire(file=relpath, exist=exists)
 if(.not.exists) error stop 77
 
 canon = realpath(relpath)
 
-if (len_trim(canon) < 28) then
-  write(stderr,*) 'ERROR: file ' // canon // ' was not canonicalized '
-  error stop
-endif
+if (len_trim(canon) < 28) error stop 'ERROR: file ' // canon // ' was not canonicalized.'
 
 print *, canon
 
diff --git a/io/terminal_io.f90 b/io/terminal_io.f90
@@ -1,3 +1,4 @@
+program terminal_io
 use, intrinsic:: iso_fortran_env
 implicit none (type, external)
 
diff --git a/io/test_pathlib.f90 b/io/test_pathlib.f90
@@ -1,4 +1,4 @@
-use, intrinsic:: iso_fortran_env, only: stderr=>error_unit
+program test_pathlib
 use pathlib, only: copyfile, mkdir, expanduser, home
 implicit none (type, external)
 
@@ -13,10 +13,7 @@ subroutine test_home()
 character(:), allocatable :: h
 
 h = home()
-if (len(h) < 2) then
-  write(stderr,'(A)') h
-  error stop 'failed to obtain home directory'
-endif
+if (len(h) < 2) error stop 'failed to obtain home directory: ' // h
 
 end subroutine test_home
 
@@ -29,11 +26,7 @@ subroutine test_expanduser(path)
 
 expanded = expanduser(path)
 
-if (len_trim(expanded) <= len_trim(path)) then
-  write(stderr,'(A)') path
-  write(stderr,'(A)') expanded
-  error stop 'did not expand path'
-endif
+if (len_trim(expanded) <= len_trim(path)) error stop 'did not expand path' // path // ' ' // expanded
 
 print *,'OK: expanduser'
 
@@ -56,12 +49,9 @@ subroutine test_mkdir(path)
 close(u)
 
 inquire(file=fpath, exist=exists)
-if(.not.exists) then
-  write(stderr,'(A)') fpath // ' failed to be created'
-  error stop
-endif
+if(.not.exists) error stop fpath // ' failed to be created'
 
 print *, 'OK: mkdir()'
 end subroutine test_mkdir
 
-end program
+end program
diff --git a/lapack95/demo_gesvd.in.f90 b/lapack95/demo_gesvd.in.f90
@@ -2,7 +2,7 @@ program demo_gesvd
 
 @lapack95_use@
 
-use,intrinsic:: iso_fortran_env, only: sp=>real32, dp=>real64, compiler_version, stderr=>error_unit
+use,intrinsic:: iso_fortran_env, only: sp=>real32, dp=>real64, compiler_version
 
 implicit none (type, external)
 
diff --git a/lapack95/intel_dgesvd.f90 b/lapack95/intel_dgesvd.f90
@@ -54,9 +54,6 @@ program intel_dgesvd
 
 maxerr=maxval(abs(e64))
 
-if (maxerr > 1e-7_dp) then
-  write(stderr,*) 'excessive singular value error'
-  error stop
-endif
+if (maxerr > 1e-7_dp) error stop 'excessive singular value error'
 
 end program
diff --git a/meson/meson.build b/meson/meson.build
@@ -16,6 +16,10 @@ os = host_machine.system()
 # -- compiler capabilities
 
 f18errorstop = fc.links('character :: b; error stop b; end', name: 'F2018 error stop')
+if not f18errorstop
+  error('Fortran 2018 error stop is used throughout.')
+endif
+
 f08block = fc.links('block; end block; end', name : 'F2008 block')
 f08contig = fc.links('print*,is_contiguous([0,0]); end', name: 'F2008 contiguous')
 f08command = fc.links('integer foo; call execute_command_line(" ", cmdstat=foo); end', name : 'F2008 execute_command_line')
diff --git a/mpi/thread_pass.f90 b/mpi/thread_pass.f90
@@ -1,7 +1,7 @@
 program mpi_pass
 !! passes data between two threads
 !!  Author:  John Burkardt
-use, intrinsic :: iso_fortran_env, only: sp=>real32, stderr=>error_unit, compiler_version
+use, intrinsic :: iso_fortran_env, only: sp=>real32, compiler_version
 use mpi, only : MPI_STATUS_SIZE, mpi_comm_world, mpi_init, mpi_get_count, &
   mpi_real, mpi_any_source, mpi_any_tag, mpi_source, mpi_tag, mpi_comm_size
 
diff --git a/overloading/CMakeLists.txt b/overloading/CMakeLists.txt
@@ -1,8 +1,6 @@
 add_executable(proc pragma.f90)
-add_test(NAME FortranPragma COMMAND proc)
+add_test(NAME overloading:Pragma COMMAND $<TARGET_FILE:proc>)
 
-if(f18errorstop)
-  add_executable(f18es f2018errorstop.f90)
-  add_test(NAME F18errorstop COMMAND f18es)
-  set_tests_properties(F18errorstop PROPERTIES WILL_FAIL true)
-endif()
+add_executable(f18es f2018errorstop.f90)
+add_test(NAME overloading:F18errorstop COMMAND $<TARGET_FILE:f18es>)
+set_tests_properties(overloading:F18errorstop PROPERTIES WILL_FAIL true)
diff --git a/overloading/meson.build b/overloading/meson.build
@@ -3,10 +3,8 @@ test('Pragma', proc,
   suite: 'overloading',
   timeout: 10)
 
-if f18errorstop
-  f18es_exe = executable('f18es', 'f2018errorstop.f90')
-  test('F18errorstop', f18es_exe,
-    should_fail: true,
-    suite: 'overloading',
-    timeout: 5)
-endif
+f18es_exe = executable('f18es', 'f2018errorstop.f90')
+test('F18errorstop', f18es_exe,
+  should_fail: true,
+  suite: 'overloading',
+  timeout: 5)
diff --git a/random/random_init.f90 b/random/random_init.f90
@@ -1,7 +1,5 @@
 submodule (random) randinit
 
-use, intrinsic:: iso_fortran_env, only: stderr=>error_unit
-
 implicit none (type, external)
 
 contains
@@ -16,17 +14,10 @@
 open(newunit=u, file='/dev/urandom', access="stream", &
      form="unformatted", action="read", status="old", iostat=ios)
 
-if (ios==0) then
-  read(u,iostat=ios) seed
-  close(u)
-endif
-
-if (ios/=0) then
-  write(stderr,*) 'falling back to internal random number generator'
-  do i = 1,n
-    seed(i) = randint(-1073741823, 1073741823)
-  enddo
-endif
+if (ios/=0) return
+
+read(u,iostat=ios) seed
+close(u)
 
 call random_seed(put=seed)
 !print *,'seed: ',seed    ! for debug/test
diff --git a/real/finite.f90 b/real/finite.f90
@@ -1,6 +1,6 @@
 program finiteness
 
-  use, intrinsic:: ieee_arithmetic
+use, intrinsic:: ieee_arithmetic
 use, intrinsic:: iso_fortran_env, only: stderr=>error_unit, sp=>real32, dp=>real64, qp=>real128
 
 use assert, only: isclose, assert_isclose
diff --git a/real/huge_precision.f90 b/real/huge_precision.f90
diff --git a/standard/bitpat.f90 b/standard/bitpat.f90
diff --git a/system/CMakeLists.txt b/system/CMakeLists.txt
diff --git a/system/gitrev.f90 b/system/gitrev.f90
diff --git a/system/meson.build b/system/meson.build
diff --git a/system/play_sound.f90 b/system/play_sound.f90
