check function, version prop

doc

Author: scivision

README.md

@@ -42,7 +42,7 @@ It's possible to do these things, if there is user need.
 Requirements:
 
 * modern Fortran compiler (this project uses `submodule` and `error stop`). For example, Gfortran ≥ 6.
-* HDF5 Fortran library (1.8 or 1.10)
+* HDF5 Fortran library (>= 1.8.7, including 1.10.x and 1.12.x)
   * Mac / Homebrew: `brew install gcc hdf5`
   * Linux: `apt install gfortran libhdf5-dev`
   * Windows Subsystem for Linux: `apt install gfortran libhdf5-dev`

src/hdf5_interface.f90

@@ -3,7 +3,8 @@ module h5fortran
 use, intrinsic :: iso_c_binding, only : c_ptr, c_loc
 use, intrinsic :: iso_fortran_env, only : real32, real64, int32, int64, stderr=>error_unit
 use hdf5, only : HID_T, SIZE_T, HSIZE_T, H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F, H5F_ACC_TRUNC_F, &
-    h5open_f, h5close_f, h5gcreate_f, h5gclose_f, h5fopen_f, h5fcreate_f, h5fclose_f, h5lexists_f
+    h5open_f, h5close_f, h5gcreate_f, h5gclose_f, h5fopen_f, h5fcreate_f, h5fclose_f, h5lexists_f, &
+    h5get_libversion_f, h5eset_auto_f
 
 use string_utils, only : toLower, strip_trailing_null, truncate_string_null
 
@@ -21,7 +22,8 @@ module h5fortran
 
 integer :: comp_lvl = 0 !< compression level (1-9)  0: disable compression
 integer(HSIZE_T) :: chunk_size(7) = [1,1,1,1,1,1,1]  !< chunk size per dimension
-logical :: verbose=.false.
+logical :: verbose=.true.
+integer :: libversion(3)  !< major, minor, rel
 
 contains
 !> initialize HDF5 file
@@ -38,7 +40,7 @@ module h5fortran
   hdf_read_4d,hdf_read_5d, hdf_read_6d, hdf_read_7d
 
 !> private methods
-procedure,public :: hdf_write_group, &
+procedure,private :: hdf_write_group, &
 hdf_write_scalar, hdf_write_1d, hdf_write_2d, hdf_write_3d, &
   hdf_write_4d, hdf_write_5d, hdf_write_6d, hdf_write_7d, &
 hdf_read_scalar, hdf_read_1d, hdf_read_2d, hdf_read_3d, &
@@ -228,13 +230,13 @@ end subroutine writeattr
 integer, parameter :: ENOENT = 2, EIO = 5
 
 private
-public :: hdf5_file, toLower, hsize_t, strip_trailing_null, truncate_string_null
+public :: hdf5_file, toLower, hsize_t, strip_trailing_null, truncate_string_null, check
 
 
 contains
 
 
-subroutine hdf_initialize(self,filename,ierr, status,action,comp_lvl,chunk_size)
+subroutine hdf_initialize(self,filename,ierr, status,action,comp_lvl,chunk_size,verbose)
 !! Opens hdf5 file
 
 class(hdf5_file), intent(inout)    :: self
@@ -244,6 +246,7 @@ subroutine hdf_initialize(self,filename,ierr, status,action,comp_lvl,chunk_size)
 character(*), intent(in), optional :: action
 integer, intent(in), optional      :: comp_lvl
 integer, intent(in), optional      :: chunk_size(:)
+logical, intent(in), optional      :: verbose
 
 character(:), allocatable :: lstatus, laction
 logical :: exists
@@ -254,13 +257,23 @@ subroutine hdf_initialize(self,filename,ierr, status,action,comp_lvl,chunk_size)
 
 if (present(comp_lvl)) self%comp_lvl = comp_lvl
 if (present(chunk_size)) self%chunk_size(1:size(chunk_size)) = chunk_size
+if (present(verbose)) self%verbose = verbose
 
 !> Initialize FORTRAN interface.
 call h5open_f(ierr)
-if (ierr /= 0) then
-  write(stderr,*) 'ERROR: HDF5 library initialize'
-  return
+if (check(ierr, 'ERROR: HDF5 library initialize')) return
+
+!> get library version
+call h5get_libversion_f(self%libversion(1), self%libversion(2), self%libversion(3), ierr)
+! if (self%verbose) print '(A,3I3)', 'HDF5 version: ',self%libversion
+if (check(ierr, 'ERROR: HDF5 library get version')) return
+
+if(self%verbose) then
+  call h5eset_auto_f(1, ierr)
+else
+  call h5eset_auto_f(0, ierr)
 endif
+if (check(ierr, 'ERROR: HDF5 library set traceback')) return
 
 lstatus = 'old'
 if(present(status)) lstatus = toLower(status)
@@ -277,34 +290,24 @@ subroutine hdf_initialize(self,filename,ierr, status,action,comp_lvl,chunk_size)
         if (.not.exists) then
           write(stderr,*) 'ERROR: ' // filename // ' does not exist.'
           ierr = ENOENT
-          return
         endif
         call h5fopen_f(filename,H5F_ACC_RDONLY_F,self%lid,ierr)
       case('write','readwrite','w','rw', 'r+', 'append', 'a')
         call h5fopen_f(filename,H5F_ACC_RDWR_F,self%lid,ierr)
-        if (ierr /= 0) then
-          write(stderr,*) 'ERROR: ' // filename // ' could not be opened'
-          ierr = EIO
-          return
-        endif
+        if (check(ierr, 'ERROR: ' // filename // ' could not be opened')) return
       case default
         write(stderr,*) 'Unsupported action -> ' // laction
         ierr = 128
-        return
       endselect
   case('new','replace')
     call h5fcreate_f(filename, H5F_ACC_TRUNC_F, self%lid, ierr)
-    if (ierr /= 0) then
-      write(stderr,*) 'ERROR: ' // filename // ' could not be created'
-      ierr = EIO
-      return
-    endif
+    if (check(ierr, 'ERROR: ' // filename // ' could not be created')) return
   case default
     write(stderr,*) 'Unsupported status -> '// lstatus
     ierr = 128
-    return
 endselect
 
+
 end subroutine hdf_initialize
 
 
@@ -314,14 +317,11 @@ subroutine hdf_finalize(self, ierr)
 
 !> close hdf5 file
 call h5fclose_f(self%lid, ierr)
-if (ierr /= 0) then
-  write(stderr,*) 'ERROR: HDF5 file close: ' // self%filename
-  return
-endif
+if (check(ierr, 'ERROR: HDF5 file close: ' // self%filename)) return
 
 !>  Close Fortran interface.
 call h5close_f(ierr)
-if (ierr /= 0) write(stderr,*) 'ERROR: HDF5 library close'
+if (check(ierr, 'ERROR: HDF5 library close')) return
 
 end subroutine hdf_finalize
 
@@ -351,26 +351,30 @@ subroutine hdf_write_group(self, gname, ierr)
   ! check subgroup exists
   sp = sp + ep
   call h5lexists_f(self%lid, gname(1:sp-1), gexist, ierr)
-  if (ierr /= 0) then
-    write(stderr,*) 'ERROR: did not find group ' // gname // ' in ' // self%filename
-    return
-  endif
+  if (check(ierr, 'ERROR: did not find group ' // gname // ' in ' // self%filename)) return
 
   if(.not.gexist) then
     call h5gcreate_f(self%lid, gname(1:sp-1), gid, ierr)
-    if (ierr /= 0) then
-      write(stderr,*) 'ERROR: creating group ' // gname // ' in ' // self%filename
-      return
-    endif
+    if (check(ierr, 'ERROR: creating group ' // gname // ' in ' // self%filename)) return
 
     call h5gclose_f(gid, ierr)
-    if (ierr /= 0) then
-      write(stderr,*) 'ERROR: closing group ' // gname // ' in ' // self%filename
-      return
-    endif
+    if (check(ierr, 'ERROR: closing group ' // gname // ' in ' // self%filename)) return
   endif
 end do
 
 end subroutine hdf_write_group
 
+
+logical function check(ierr, msg)
+integer, intent(in) :: ierr
+character(*), intent(in) :: msg
+
+check = ierr /= 0
+if (.not.check) return
+
+write(stderr, *) msg
+
+end function check
+
+
 end module h5fortran

src/read.f90

@@ -29,7 +29,7 @@
 endif
 
 call h5ltget_dataset_info_f(self%lid, dname, dims, dtype, dsize, ierr)
-if (ierr /= 0) write(stderr,*) 'ERROR: open ' // dname // ' read ' // self%filename
+if (check(ierr, 'ERROR: open ' // dname // ' read ' // self%filename)) return
 
 end procedure hdf_setup_read
 
@@ -48,14 +48,11 @@
 endif
 
 call h5ltget_dataset_ndims_f(self%lid, dname, drank, ierr)
-if (ierr /= 0) then
-  write(stderr,*) 'ERROR: '// dname // ' rank ' // self%filename
-  return
-endif
+if (check(ierr, 'ERROR: '// dname // ' rank ' // self%filename)) return
 
 allocate(dims(drank))
 call h5ltget_dataset_info_f(self%lid, dname, dims, dtype, dsize, ierr)
-if (ierr /= 0) write(stderr,*) 'ERROR: ' // dname // ' info ' // self%filename
+if (check(ierr, 'ERROR: ' // dname // ' info ' // self%filename)) return
 
 end procedure hdf_get_shape
 

src/tests/test_error.f90

@@ -39,7 +39,7 @@ subroutine test_nonexist_old_file(path)
 character(*), intent(in) :: path
 integer :: ierr
 
-call h5f%initialize(path//'/not-exist', ierr, status='old', action='read')
+call h5f%initialize(path//'/not-exist', ierr, status='old', action='read', verbose=.false.)
 if (ierr==0) error stop 'should have had ierr/=0 on non-existing old file'
 end subroutine test_nonexist_old_file
 
@@ -48,7 +48,7 @@ subroutine test_nonexist_unknown_file(path)
 character(*), intent(in) :: path
 integer :: ierr
 
-call h5f%initialize(path//'/not-exist', ierr, status='unknown', action='read')
+call h5f%initialize(path//'/not-exist', ierr, status='unknown', action='read', verbose=.false.)
 if (ierr==0) error stop 'should have had ierr/=0 on non-existing unknown read file'
 end subroutine test_nonexist_unknown_file
 
@@ -75,7 +75,7 @@ subroutine test_nonexist_variable(path)
 character(:), allocatable :: filename
 
 filename = path // '/junk.h5'
-call h5f%initialize(filename, ierr, status='replace', action='readwrite')
+call h5f%initialize(filename, ierr, status='replace', action='readwrite', verbose=.false.)
 if(ierr/=0) error stop 'test_nonexist_variable: opening file'
 call h5f%read('/not-exist', u, ierr)
 if(ierr==0) error stop 'test_nonexist_variable: should have ierr/=0 on non-exist variable'
@@ -90,14 +90,14 @@ subroutine test_wrong_type(path)
 character(:), allocatable :: filename
 
 filename = path // '/junk.h5'
-call h5f%initialize(filename, ierr, status='replace', action='write')
+call h5f%initialize(filename, ierr, status='replace', action='write', verbose=.false.)
 if(ierr/=0) error stop 'test_wrong_type: creating file'
 call h5f%write('/real32', 42., ierr)
 if(ierr/=0) error stop 'test_wrong_type: writing test variable'
 call h5f%finalize(ierr)
 if (ierr/=0) error stop 'test_nonexist_variable: finalizing'
 
-call h5f%initialize(filename, ierr, status='old', action='read')
+call h5f%initialize(filename, ierr, status='old', action='read', verbose=.false.)
 if(ierr/=0) error stop 'test_wrong_type: opening file'
 call h5f%read('/real32', u, ierr)
 if(ierr/=0) then
@@ -119,7 +119,7 @@ subroutine test_unknown_write(path)
 x = (1, -1)
 
 filename = path // '/junk.h5'
-call h5f%initialize(filename, ierr, status='replace', action='write')
+call h5f%initialize(filename, ierr, status='replace', action='write', verbose=.false.)
 if(ierr/=0) error stop 'test_unknown_write: creating file'
 call h5f%write('/complex', x, ierr)
 if(ierr==0) error stop 'test_unknown_write: writing unknown type variable'
@@ -135,7 +135,7 @@ subroutine test_unknown_read(path)
 x = (1, -1)
 
 filename = path // '/junk.h5'
-call h5f%initialize(filename, ierr, status='unknown', action='readwrite')
+call h5f%initialize(filename, ierr, status='unknown', action='readwrite', verbose=.false.)
 if(ierr/=0) error stop 'test_unknown_read: opening file'
 call h5f%read('/complex', x, ierr)
 if(ierr==0) error stop 'test_unknown_read: reading unknown type variable'