allow reopening same file with same action/mode

Author: scivision

src/attr_read.inc

@@ -22,7 +22,7 @@ call get_obj_class(self, obj_name // ":" // attr_name, attr_id, attr_class)
 
 !> cast the dataset read from disk to the variable type presented by user h5f%read("/my_dataset", x, "y")
 !! select case doesn't allow H5T_*
-if(attr_class == H5T_FLOAT_F .OR. attr_class == H5T_INTEGER_F) then
+if(any(attr_class == [H5T_FLOAT_F, H5T_INTEGER_F])) then
   select type(A)
   type is (real(real64))
     call H5Aread_f(attr_id, H5T_NATIVE_DOUBLE, A, attr_dims, ier)

src/interface.f90

@@ -17,8 +17,9 @@ module h5fortran
 !> main type
 type :: hdf5_file
 
-character(:), allocatable :: filename
+character(:), allocatable :: filename, last_error
 integer(HID_T) :: file_id = 0  !< sentinel value to avoid uninitialized variable lint
+integer :: file_mode = -1
 
 logical :: debug = .false.
 logical :: fletcher32 = .false.

src/read_scalar.f90

@@ -39,7 +39,7 @@
 !> We only cast when needed to save memory.
 !! select case doesn't allow H5T_*
 !! https://support.hdfgroup.org/HDF5/doc/UG/HDF5_Users_Guide-Responsive%20HTML5/index.html#t=HDF5_Users_Guide%2FDatatypes%2FHDF5_Datatypes.htm%23TOC_6_10_Data_Transferbc-26&rhtocid=6.5_2
-if(dclass == H5T_FLOAT_F .OR. dclass == H5T_INTEGER_F) then
+if(any(dclass == [H5T_FLOAT_F, H5T_INTEGER_F])) then
   select type(A)
   type is (real(real64))
     call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE, A, dims, ier, mem_space_id, file_space_id)

src/reader.inc

@@ -25,7 +25,7 @@ call get_obj_class(self, dname, dset_id, dclass)
 
 !> casting is handled by HDF5 library internally
 !! select case doesn't allow H5T_*
-if(dclass == H5T_FLOAT_F .OR. dclass == H5T_INTEGER_F) then
+if(any(dclass == [H5T_FLOAT_F, H5T_INTEGER_F])) then
   select type(A)
   type is (real(real64))
     call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, A, dims, ier, mem_space_id, file_space_id, xfer_id)

src/utils.f90

@@ -8,7 +8,7 @@
 h5fget_obj_count_f, h5fget_obj_ids_f, h5fget_name_f, &
 h5sselect_hyperslab_f, h5screate_simple_f, &
 H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, &
-H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F, H5F_ACC_TRUNC_F, &
+H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F, H5F_ACC_TRUNC_F, H5F_ACC_EXCL_F, &
 H5F_OBJ_FILE_F, H5F_OBJ_GROUP_F, H5F_OBJ_DATASET_F, H5F_OBJ_DATATYPE_F, H5F_OBJ_ALL_F, &
 H5D_CONTIGUOUS_F, H5D_CHUNKED_F, H5D_COMPACT_F, &
 H5I_FILE_F, &
@@ -35,27 +35,69 @@
 
 module procedure h5open
 
-character(2) :: laction
 integer :: ier
 integer(HID_T) :: fapl !< file access property list
-integer :: file_mode
 
 if(present(ok)) ok = .true.
 
+if(present(debug)) self%debug = debug
+
 if(self%is_open()) then
   write(stderr, '(a)') 'NOTICE:h5fortran:open: file handle already open: '//self%filename
   return
 endif
 
-laction = 'r'
-if (present(action)) laction = action
+!> Initialize FORTRAN interface
+!! HDF5 1.14.0 introduced bug that if H5open_f is called more than once,
+!! it will error.
+if (.not. hdf5_is_initialized()) then
+  if(self%debug) print '(a)', 'TRACE:h5fortran:h5open: initializing HDF5 library'
+  call H5open_f(ier)
+  call estop(ier, 'h5open:H5open HDF5 library initialize', self%filename, ok=ok)
+  if (present(ok)) then
+    if (.not. ok) return
+  endif
+endif
 
-self%filename = filename
+!! these enums will all be 0 if h5open_f isn't called first
+! print *, "TRACE: self%file_mode = ", self%file_mode, " filename = ", filename
+! print *, "TRACE: H5F_ACC_RDONLY_F = ", H5F_ACC_RDONLY_F
+! print *, "TRACE: H5F_ACC_RDWR_F = ", H5F_ACC_RDWR_F
+! print *, "TRACE: H5F_ACC_TRUNC_F = ", H5F_ACC_TRUNC_F
 
-if(present(debug)) self%debug = debug
+if (present(action)) then
+  select case(action)
+    case('r')
+      self%file_mode = H5F_ACC_RDONLY_F
+    case('r+')
+      self%file_mode = H5F_ACC_RDWR_F
+    case('rw', 'a')
+      if(is_hdf5(filename)) then
+        self%file_mode = H5F_ACC_RDWR_F
+      else
+        self%file_mode = H5F_ACC_TRUNC_F
+      endif
+    case ('w')
+      self%file_mode = H5F_ACC_TRUNC_F
+    case default
+      call estop(ier, 'ERROR:h5fortran:open Unsupported action=' // action, filename, ok=ok)
+      if (present(ok)) then
+        if(.not. ok) return
+      endif
+  end select
+elseif (self%filename == filename .and. any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then
+  if(self%debug) print '(3a,i0)', 'NOTICE:h5fortran:open: ', filename, ' reusing file mode ', self%file_mode
+else
+  self%file_mode = H5F_ACC_RDONLY_F
+  if(self%debug) print '(a)', 'NOTICE:h5fortran:open: no action specified, defaulting to read-only mode'
+endif
+
+self%filename = filename
+!! do this AFTER the action= switch
 
 !> compression parameter
-if(present(comp_lvl) .and. laction /= "r") self%comp_lvl = comp_lvl
+if(present(comp_lvl) .and. self%file_mode /= H5F_ACC_RDONLY_F) self%comp_lvl = comp_lvl
+
 if(self%comp_lvl > 0) then
   self%shuffle = .true.
   self%fletcher32 = .true.
@@ -72,75 +114,41 @@
   self%comp_lvl = 9
 endif
 
-!> Initialize FORTRAN interface
-!! HDF5 1.14.0 introduced bug that if H5open_f is called more than once,
-!! it will error.
-if (.not. hdf5_is_initialized()) then
-  if(self%debug) print '(a)', 'TRACE:h5fortran:h5open: initializing HDF5 library'
-  call H5open_f(ier)
-  call estop(ier, 'h5open:H5open HDF5 library initialize', filename, ok=ok)
-  if (present(ok)) then
-    if (.not. ok) return
-  endif
-endif
-
 if(self%debug) then
   call H5Eset_auto_f(1, ier)
 else
   call H5Eset_auto_f(0, ier)
 endif
-call estop(ier, 'h5open:H5Eset_auto: HDF5 library set traceback', filename, ok=ok)
+call estop(ier, 'h5open:H5Eset_auto: HDF5 library set traceback', self%filename, ok=ok)
 if (present(ok)) then
   if(.not. ok) return
 endif
 
-select case(laction)
-case('r')
-  file_mode = H5F_ACC_RDONLY_F
-case('r+')
-  file_mode = H5F_ACC_RDWR_F
-case('rw', 'a')
-  if(is_hdf5(filename)) then
-    file_mode = H5F_ACC_RDWR_F
-  else
-    file_mode = H5F_ACC_TRUNC_F
-  endif
-case ('w')
-  file_mode = H5F_ACC_TRUNC_F
-case default
-  call estop(ier, 'ERROR:h5fortran:open Unsupported action ' // laction, filename, ok=ok)
-  if (present(ok)) then
-    if(.not. ok) return
-  endif
-
-end select
-
 fapl = H5P_DEFAULT_F
 
-!! these enums will all be 0 if h5open_f isn't called first
-! print *, "TRACE: file_mode = ", file_mode, " filename = ", filename
-! print *, "TRACE: H5F_ACC_RDONLY_F = ", H5F_ACC_RDONLY_F
-! print *, "TRACE: H5F_ACC_RDWR_F = ", H5F_ACC_RDWR_F
-! print *, "TRACE: H5F_ACC_TRUNC_F = ", H5F_ACC_TRUNC_F
-
-
-if (file_mode == H5F_ACC_RDONLY_F .or. file_mode == H5F_ACC_RDWR_F) then
+if (any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then
   if(.not. is_hdf5(filename)) then
-    error stop "ERROR:h5fortran:open: action=" // laction // "  not an HDF5 file: " // filename
+    write(stderr, '(a,i0)') "ERROR:h5fortran:open: is not an HDF5 file: " // self%filename // " file mode ", self%file_mode
+    if (present(ok)) then
+      ok = .false.
+      return
+    else
+      error stop
+    endif
   endif
-  call H5Fopen_f(filename, file_mode, self%file_id, ier, access_prp=fapl)
-  call estop(ier, "h5open:H5Fopen", filename, ok=ok)
+  call H5Fopen_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl)
+  call estop(ier, "h5open:H5Fopen", self%filename, ok=ok)
   if (present(ok)) then
     if(.not. ok) return
   endif
-elseif(file_mode == H5F_ACC_TRUNC_F) then
-  call H5Fcreate_f(filename, file_mode, self%file_id, ier, access_prp=fapl)
-  call estop(ier, "h5open:H5Fcreate", filename, ok=ok)
+elseif(self%file_mode == H5F_ACC_TRUNC_F) then
+  call H5Fcreate_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl)
+  call estop(ier, "h5open:H5Fcreate", self%filename, ok=ok)
   if (present(ok)) then
     if(.not. ok) return
   endif
 else
-  error stop "ERROR:h5fortran:open: Unsupported file mode: " // filename
+  error stop "ERROR:h5fortran:open: Unsupported file mode: " // self%filename
 endif
 
 end procedure h5open