improve file open logic

scivision · scivision · commit 54f6008e0acc · 2025-07-03T22:27:34.000-04:00
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -7,7 +7,7 @@ endif()
 
 project(h5fortran
 LANGUAGES C Fortran
-VERSION 4.11.0
+VERSION 4.12.0
 )
 
 include(CTest)
diff --git a/cmake/check_hdf5.f90 b/cmake/check_hdf5.f90
@@ -17,7 +17,7 @@ program main
 print '(a,i0)', "H5F_ACC_TRUNC_F = ", H5F_ACC_TRUNC_F
 print '(a,i0)', "H5F_ACC_RDWR_F = ", H5F_ACC_RDWR_F
 
-if(H5F_ACC_RDONLY_F == H5F_ACC_TRUNC_F .or. H5F_ACC_RDONLY_F == H5F_ACC_RDWR_F) then
+if(any(H5F_ACC_RDONLY_F == [H5F_ACC_TRUNC_F, H5F_ACC_RDWR_F])) then
     error stop "H5F_ACC_RDONLY, H5F_ACC_TRUNC, H5F_ACC_RDWR are not all distinct"
 endif
 
diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt
@@ -1,4 +1,4 @@
-cmake_minimum_required(VERSION 3.22...3.27)
+cmake_minimum_required(VERSION 3.22...4.1)
 
 project(h5fortranExample
 LANGUAGES C CXX Fortran)
@@ -11,21 +11,13 @@ find_package(h5fortran CONFIG REQUIRED)
 add_library(fortran_interface fortran_interface.f90)
 target_link_libraries(fortran_interface PRIVATE h5fortran::h5fortran)
 
-add_executable(ex_fcn ex_fcn.f90)
-target_link_libraries(ex_fcn PRIVATE h5fortran::h5fortran)
-add_test(NAME Fortran_fcn COMMAND ex_fcn)
+foreach(t IN ITEMS ex_fcn ex_oo ex_oo3d char_repeat_read vtk_write)
 
-add_executable(ex_oo ex_oo.f90)
-target_link_libraries(ex_oo PRIVATE h5fortran::h5fortran)
-add_test(NAME Fortran_oo COMMAND ex_oo)
+add_executable(${t} ${t}.f90)
+target_link_libraries(${t} PRIVATE h5fortran::h5fortran)
+add_test(NAME Fortran_${t} COMMAND ${t})
 
-add_executable(repeat_char_read char_repeat_read.f90)
-target_link_libraries(repeat_char_read PRIVATE h5fortran::h5fortran)
-
-## VTK HDF5 write example
-add_executable(vtk_write vtk_write.f90)
-target_link_libraries(vtk_write PRIVATE h5fortran::h5fortran)
-add_test(NAME VTK COMMAND vtk_write ${CMAKE_CURRENT_BINARY_DIR}/vtk.hdf)
+endforeach()
 
 ## C, C++ examples
 
@@ -45,11 +37,15 @@ add_test(NAME CPP_fcn COMMAND cpp_fcn)
 get_property(test_names DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} PROPERTY TESTS)
 set_property(TEST ${test_names} PROPERTY WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})
 
+if(NOT DEFINED LINUX AND CMAKE_SYSTEM_NAME STREQUAL "Linux")
+  set(LINUX true)
+endif()
+
 if(WIN32)
 set_property(TEST ${test_names} PROPERTY
   ENVIRONMENT_MODIFICATION "PATH=path_list_prepend:${ZLIB_INCLUDE_DIRS}/../bin;PATH=path_list_prepend:${h5fortran_DIR}/../bin"
   )
-elseif(CMAKE_SYSTEM_NAME STREQUAL "Linux")
+elseif(LINUX)
 set_property(TEST ${test_names} PROPERTY
   ENVIRONMENT_MODIFICATION "LD_LIBRARY_PATH=path_list_prepend:${ZLIB_INCLUDE_DIRS}/../lib;LD_LIBRARY_PATH=path_list_prepend:${h5fortran_DIR}/../lib"
   )
diff --git a/example/ex_oo3d.f90 b/example/ex_oo3d.f90
@@ -0,0 +1,26 @@
+program demo
+
+use h5fortran, only : hdf5_file
+
+implicit none
+
+character(len=*), parameter :: h5file = 'test_oo3d.h5'
+
+type(hdf5_file) :: h5f
+
+real, allocatable :: v3(:, :, :)
+
+allocate(v3(2, 4, 3))
+
+v3 = 0.
+
+call h5f % open(h5file, action='rw', debug=.true.)
+call h5f % write('/value1', 123.)
+call h5f % close()
+
+!> must always specify action= even if reopening previous file
+call h5f % open(h5file, action='rw', comp_lvl = 1, debug=.true.)
+call h5f % write('/value2', v3)
+call h5f % close()
+
+end program
diff --git a/example/vtk_write.f90 b/example/vtk_write.f90
@@ -26,7 +26,7 @@ program vtk_write
 real, allocatable :: Iterations(:,:,:), IterationsGradient(:,:,:,:)
 
 call get_command_argument(1, filename, status=ierr)
-if(ierr /= 0) error stop "please give filename to write"
+if(ierr /= 0) filename = "vtk_hdf_example.h5"
 
 call h % open(filename, 'w')
 
diff --git a/fpm.toml b/fpm.toml
@@ -1,7 +1,7 @@
 name = "h5fortran"
 description = "Lightweight object-oriented HDF5 interface"
 categories = "io"
-version = "4.11.0"
+version = "4.12.0"
 
 [build]
 auto-tests = false
diff --git a/src/attr_read.inc b/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)
diff --git a/src/interface.f90 b/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.
diff --git a/src/read_scalar.f90 b/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)
diff --git a/src/reader.inc b/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)
diff --git a/src/utils.f90 b/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,68 @@
 
 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
+
+self%filename = filename
+
 if(self%is_open()) then
-  write(stderr, '(a)') 'NOTICE:h5fortran:open: file handle already open: '//self%filename
+  write(stderr, '(a)') 'NOTICE:h5fortran:open: file handle already open: '//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', 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: 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(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
+else
+  if (self%debug) print '(a)', 'TRACE:h5fortran:open: opening file: '//filename // &
+    ' read only as no file mode is specified'
+  self%file_mode = H5F_ACC_RDONLY_F
+endif
+!! don't try to reused old file_mode based on filename as it's not reliable on many compilers.
 
-if(present(debug)) self%debug = debug
 
 !> 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 +113,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

Original file line number	Diff line number	Diff line change
`@@ -7,7 +7,7 @@ endif()`
`7`	`7`
`8`	`8`	`project(h5fortran`
`9`	`9`	`LANGUAGES C Fortran`
`10`		`-VERSION 4.11.0`
	`10`	`+VERSION 4.12.0`
`11`	`11`	`)`
`12`	`12`
`13`	`13`	`include(CTest)`