vendor pathlib, add status=scratch

Author: scivision

src/CMakeLists.txt

@@ -1,5 +1,13 @@
+
+if(WIN32)
+  set(is_windows .true.)
+else()
+  set(is_windows .false.)
+endif()
+configure_file(pathlib.in.f90 pathlib.f90)
+
 target_sources(nc4fortran PRIVATE
 interface.f90
 read.f90 reader.f90
 write.f90 writer.f90
-string_utils.f90)
+string_utils.f90 ${CMAKE_CURRENT_BINARY_DIR}/pathlib.f90)

src/interface.f90

@@ -10,6 +10,7 @@ module nc4fortran
   nf90_def_dim, nf90_put_att, nf90_def_var, nf90_get_var, nf90_put_var, nf90_float, nf90_double, nf90_int, nf90_int64, &
   nf90_inq_libvers
 
+use pathlib, only : unlink, get_tempdir, is_absolute_path
 use string_utils, only : toLower, strip_trailing_null, truncate_string_null
 
 implicit none (type, external)
@@ -28,6 +29,8 @@ module nc4fortran
 integer :: comp_lvl = 0 !< compression level (1-9)  0: disable compression
 logical :: verbose = .false.
 logical :: debug = .false.
+logical :: is_scratch = .false.
+!! will be auto-deleted on close
 character(80) :: libversion
 
 contains
@@ -251,6 +254,10 @@ subroutine nc_initialize(self,filename,ierr, status,action,comp_lvl,verbose,debu
     end select
 case('new','replace')
   ier = nf90_create(self%filename, ior(NF90_CLOBBER, NF90_NETCDF4), self%ncid)
+case('scratch')
+    ier = nf90_create(self%filename, ior(NF90_CLOBBER, NF90_NETCDF4), self%ncid)
+  self%is_scratch = .true.
+  if(.not.is_absolute_path(filename)) self%filename = get_tempdir() // '/' // filename
 case default
   write(stderr,*) 'Unsupported status -> '// lstatus
   error stop 128
@@ -279,6 +286,11 @@ subroutine nc_finalize(self, ierr)
   if (present(ierr)) return
   error stop
 endif
+
+if(self%is_scratch) then
+  if (unlink(self%filename)) write(stderr,*) 'WARNING: could not delete scratch file: ' // self%filename
+endif
+
 end subroutine nc_finalize
 
 

src/meson.build

@@ -1,4 +1,14 @@
- nc4_src = files('interface.f90',
+conf_data = configuration_data()
+
+is_windows = os == 'windows' ? '.true.' : '.false.'
+
+conf_data.set('is_windows', is_windows)
+pathlib_src = configure_file(
+  input : 'pathlib.in.f90',
+  output : 'pathlib.f90',
+  configuration : conf_data)
+
+nc4_src = files('interface.f90',
   'read.f90', 'reader.f90',
   'write.f90', 'writer.f90',
-  'string_utils.f90')
+  'string_utils.f90', meson.current_build_dir() / 'pathlib.f90')

src/pathlib.in.f90

@@ -0,0 +1,52 @@
+module pathlib
+!! vendored from Michael Hirsch's Fortran pathlib
+
+implicit none (type, external)
+
+contains
+
+function get_tempdir()
+
+character(1024) :: argv
+integer :: L, i
+character(:), allocatable :: get_tempdir
+
+call get_environment_variable("TMP", argv, L, i)
+if (L==0 .or. i/=0) call get_environment_variable("TEMP", argv, L, i)
+if (L==0 .or. i/=0) call get_environment_variable("TMPDIR", argv, L, i)
+if (L==0 .or. i/=0) argv = "/tmp"
+
+get_tempdir = trim(argv)
+
+end function get_tempdir
+
+
+pure logical function is_absolute_path(path)
+!! heuristic to determine absolute path
+
+character(*), intent(in) :: path
+
+is_absolute_path = .false.
+
+if(@is_windows@) then
+  if (lge(path(1:1), 'A') .and. lle(path(1:1), 'z') .and. path(2:2) == ':') is_absolute_path = .true.
+else
+  if(path(1:1) == '/') is_absolute_path=.true.
+endif
+
+end function
+
+
+logical function unlink(filename)
+!! deletes file in Fortran standard manner.
+character(*), intent(in) :: filename
+integer :: i, u
+
+open(newunit=u, file=filename, iostat=i)
+close(u, status='delete', iostat=i)
+
+inquire(file=filename, exist=unlink)
+
+end function unlink
+
+end module pathlib

src/tests/test_io.f90

@@ -23,6 +23,9 @@ program test_netcdf
 call test_exist(path)
 print *, 'OK: exist check'
 
+call test_scratch(path)
+print *, 'OK: scratch'
+
 call test_scalar(path)
 print *, 'OK: scalar'
 
@@ -47,6 +50,27 @@ subroutine test_exist(path)
 end subroutine test_exist
 
 
+subroutine test_scratch(path)
+
+character(*), intent(in) :: path
+type(netcdf_file) :: hf
+logical :: e
+
+call hf%initialize('scratch.nc', status='scratch')
+print *, 'scratch: ', hf%filename
+call hf%finalize()
+
+call hf%initialize(path // '/scalar.nc', status='scratch')
+print *, 'scratch: ', hf%filename
+call hf%write('here', 12)
+call hf%finalize()
+
+inquire(file=path//'/scalar.nc', exist=e)
+if(e) error stop 'scratch file was not auto-deletect'
+
+end subroutine test_scratch
+
+
 subroutine test_scalar(path)
 
 character(*), intent(in) :: path