fix pathlib

Author: scivision

character/str2int.f90

@@ -1,4 +1,4 @@
-program str2int
+program str2int_demo
 !! very simple demo of string to integer
 implicit none
 
@@ -7,7 +7,7 @@ program str2int
 
 x = '42'
 m = str2int(x)
-if (x/=42) error stop
+if (m/=42) error stop
 
 contains
 

io/CMakeLists.txt

@@ -32,10 +32,20 @@ add_test(NAME io:ReadOnly COMMAND readonly)
 add_executable(null devnull.f90)
 add_test(NAME io:nullfile COMMAND null)
 
-add_library(pathlib OBJECT pathlib.F90)
+add_library(pathlib OBJECT pathlib.f90)
 add_executable(test_pathlib test_pathlib.f90)
 target_link_libraries(test_pathlib pathlib)
 add_test(NAME io:pathlib COMMAND $<TARGET_FILE:test_pathlib>)
+if(WIN32)
+  target_sources(pathlib PRIVATE pathlib_windows.f90)
+else()
+  target_sources(pathlib PRIVATE pathlib_unix.f90)
+endif()
+if(CMAKE_Fortran_COMPILER_ID STREQUAL Intel)
+  target_sources(pathlib PRIVATE path_exists_intel.f90)
+else()
+  target_sources(pathlib PRIVATE path_exists.f90)
+endif()
 
 
 include(CheckCSourceRuns)

io/meson.build

@@ -22,7 +22,11 @@ if not(os == 'windows' and fc.get_id() == 'pgi')
     timeout: 10, suite: 'io')
 endif
 
-pathlib = library('pathlib', 'pathlib.F90')
+pathlib_src = os == 'windows' ? files('pathlib_windows.f90') : files('pathlib_unix.f90')
+pathlib_src += ['intel', 'intel-cl'].contains(fc.get_id()) ? files('path_exists_intel.f90') : files('path_exists.f90')
+
+pathlib = library('pathlib',
+sources: ['pathlib.f90', pathlib_src])
 test_pathlib = executable('test_pathlib',
   sources: 'test_pathlib.f90',
   link_with: pathlib)

io/path_exists.f90

@@ -0,0 +1,22 @@
+submodule (pathlib) path_exists
+!! this is for non-Intel compilers
+implicit none
+
+contains
+
+module procedure assert_directory_exists
+!! throw error if directory does not exist
+!! this accomodates non-Fortran 2018 error stop with variable character
+
+logical :: exists
+
+inquire(file=path, exist=exists)
+
+if (exists) return
+
+write(stderr,*) path // ' directory does not exist'
+error stop
+
+end procedure assert_directory_exists
+
+end submodule path_exists

io/path_exists_intel.f90

@@ -0,0 +1,22 @@
+submodule (pathlib) path_exists
+!! Intel compilers require non-standard inquire(directory=)
+implicit none
+
+contains
+
+module procedure assert_directory_exists
+!! throw error if directory does not exist
+!! this accomodates non-Fortran 2018 error stop with variable character
+
+logical :: exists
+
+inquire(directory=path, exist=exists)
+
+if (exists) return
+
+write(stderr,*) path // ' directory does not exist'
+error stop
+
+end procedure assert_directory_exists
+
+end submodule path_exists

io/pathlib.F90 io/pathlib.f90io/pathlib.F90 renamed to io/pathlib.f90

@@ -4,56 +4,50 @@ module pathlib
 
 implicit none
 private
-public :: mkdir, copyfile, expanduser, home
+public :: mkdir, copyfile, expanduser, home, get_suffix, filesep_swap, assert_directory_exists, assert_file_exists
+
+interface  ! pathlib_{unix,windows}.f90
+module integer function copyfile(source, dest) result(istat)
+character(*), intent(in) :: source, dest
+end function copyfile
+
+module integer function mkdir(path) result(istat)
+character(*), intent(in) :: path
+end function mkdir
+end interface
+
+interface ! path_exists*.f90
+module subroutine assert_directory_exists(path)
+character(*), intent(in) :: path
+end subroutine assert_directory_exists
+end interface
 
 contains
 
-integer function copyfile(source, dest) result(istat)
-!! overwrites existing file in destination
-character(*), intent(in) :: source, dest
-character(len(source)) :: src
-character(len(dest)) :: dst
-logical :: exists
-integer :: icstat
-
-#if defined(_WIN32)
-!! https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/copy
-character(*), parameter :: CMD='copy /y '
-src = filesep_swap(source)
-dst = filesep_swap(dest)
-#else
-character(*), parameter ::  CMD='cp -r '
-src = source
-dst = dest
-#endif
-
-call execute_command_line(CMD//src//' '//dst, exitstat=istat, cmdstat=icstat)
-if (istat == 0 .and. icstat /= 0) istat = icstat
-if (istat /= 0) write(stderr,*) 'ERROR: '//CMD//src//' '//dst
+pure function get_suffix(filename)
+character(*), intent(in) :: filename
+character(:), allocatable :: get_suffix
+
+get_suffix = filename(index(filename, '.', back=.true.) : len(filename))
+
+end function get_suffix
 
-end function copyfile
 
+subroutine assert_file_exists(path)
+  !! throw error if file does not exist
+  !! this accomodates non-Fortran 2018 error stop with variable character
 
-integer function mkdir(path) result(istat)
-!! create a directory, with parents if needed
 character(*), intent(in) :: path
-character(len(path)) :: p
-integer :: icstat
-
-#if defined(_WIN32)
-!! https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/md
-character(*), parameter :: CMD='mkdir '
-p = filesep_swap(path)
-#else
-character(*), parameter ::  CMD='mkdir -p '
-p = path
-#endif
-
-call execute_command_line(CMD // p, exitstat=istat, cmdstat=icstat)
-if (istat == 0 .and. icstat /= 0) istat = icstat
-if (istat /= 0) write(stderr,*) 'ERROR: '//CMD//p
+logical :: exists
 
-end function mkdir
+inquire(file=path, exist=exists)
+
+if (exists) return
+
+write(stderr,'(A)') 'ERROR: file does not exist ' // path
+error stop
+
+end subroutine assert_file_exists
 
 
 function filesep_swap(path) result(swapped)
@@ -105,20 +99,18 @@ end function expanduser
 
 function home()
 !! https://en.wikipedia.org/wiki/Home_directory#Default_home_directory_per_operating_system
-character(:), allocatable :: home, var
+character(:), allocatable :: home
 character(256) :: buf
 integer :: L, istat
 
-#if defined(_WIN32)
-var = "USERPROFILE"
-#else
-var = "HOME"
-#endif
+call get_environment_variable("HOME", buf, length=L, status=istat)
+if (L==0 .or. istat /= 0) then
+  call get_environment_variable("USERPROFILE", buf, length=L, status=istat)
+endif
 
-call get_environment_variable(var, buf, length=L, status=istat)
 if (L==0 .or. istat /= 0) then
-  write(stderr,*) 'ERROR: could not determine home directory from env var ',var
-  if (istat==1) write(stderr,*) 'env var ',var,' does not exist.'
+  write(stderr,*) 'ERROR: could not determine home directory from env variable'
+  if (istat==1) write(stderr,*) 'env variable does not exist.'
   home = ""
 else
   home = trim(buf) // '/'

io/pathlib_unix.f90

@@ -0,0 +1,30 @@
+submodule (pathlib) pathlib_unix
+
+implicit none
+
+contains
+
+module procedure copyfile
+
+integer :: icstat
+!! https://linux.die.net/man/1/cp
+character(*), parameter ::  CMD='cp -rf '
+
+call execute_command_line(CMD // source // ' ' // dest, exitstat=istat, cmdstat=icstat)
+if (istat == 0 .and. icstat /= 0) istat = icstat
+
+end procedure copyfile
+
+
+module procedure mkdir
+!! create a directory, with parents if needed
+integer :: icstat
+
+character(*), parameter ::  CMD='mkdir -p '
+
+call execute_command_line(CMD // path, exitstat=istat, cmdstat=icstat)
+if (istat == 0 .and. icstat /= 0) istat = icstat
+
+end procedure mkdir
+
+end submodule pathlib_unix

io/pathlib_windows.f90

@@ -0,0 +1,31 @@
+submodule (pathlib) pathlib_windows
+
+implicit none
+
+contains
+
+module procedure copyfile
+
+integer :: icstat
+!! https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/copy
+character(*), parameter :: CMD='copy /y '
+
+call execute_command_line(CMD // filesep_swap(source) // ' ' // filesep_swap(dest), exitstat=istat, cmdstat=icstat)
+if (istat == 0 .and. icstat /= 0) istat = icstat
+
+end procedure copyfile
+
+
+module procedure mkdir
+!! create a directory, with parents if needed
+integer :: icstat
+!! https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/md
+character(*), parameter :: CMD='mkdir '
+
+call execute_command_line(CMD // filesep_swap(path), exitstat=istat, cmdstat=icstat)
+if (istat == 0 .and. icstat /= 0) istat = icstat
+
+end procedure mkdir
+
+
+end submodule pathlib_windows