Skip to content

Commit d000c7c

Browse files
scivisionscivision
committed
allow reopening same file with same action/mode
1 parent 0ce1e6c commit d000c7c

File tree

8 files changed

+109
-66
lines changed

8 files changed

+109
-66
lines changed

‎CMakeLists.txt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ endif()
77

88
project(h5fortran
99
LANGUAGES C Fortran
10-
VERSION 4.11.0
10+
VERSION 4.12.0
1111
)
1212

1313
include(CTest)

‎example/ex_oo3d.f90

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
program demo
2+
3+
use h5fortran, only : hdf5_file
4+
5+
implicit none
6+
7+
character(len=*), parameter :: h5file = 'test_oo3d.h5'
8+
9+
type(hdf5_file) :: h5f
10+
11+
real, allocatable :: v3(:, :, :)
12+
13+
allocate(v3(2, 4, 3))
14+
15+
v3 = 0.
16+
17+
call h5f % open(h5file, action='rw', debug=.true.)
18+
call h5f % write('/value1', 123.)
19+
call h5f % close()
20+
21+
print '(2a)', 'opening HDF5 file: ', h5file
22+
call h5f % open(h5file, comp_lvl = 1, debug=.true.)
23+
24+
print '(a)', 'Writing 3D array to dataset /value2'
25+
call h5f % write('/value2', v3)
26+
call h5f % close()
27+
28+
end program

‎fpm.toml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
name = "h5fortran"
22
description = "Lightweight object-oriented HDF5 interface"
33
categories = "io"
4-
version = "4.11.0"
4+
version = "4.12.0"
55

66
[build]
77
auto-tests = false

‎src/attr_read.inc

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ call get_obj_class(self, obj_name // ":" // attr_name, attr_id, attr_class)
2222

2323
!> cast the dataset read from disk to the variable type presented by user h5f%read("/my_dataset", x, "y")
2424
!! select case doesn't allow H5T_*
25-
if(attr_class == H5T_FLOAT_F .OR. attr_class == H5T_INTEGER_F) then
25+
if(any(attr_class == [H5T_FLOAT_F, H5T_INTEGER_F])) then
2626
select type(A)
2727
type is (real(real64))
2828
call H5Aread_f(attr_id, H5T_NATIVE_DOUBLE, A, attr_dims, ier)

‎src/interface.f90

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,9 @@ module h5fortran
1717
!> main type
1818
type :: hdf5_file
1919

20-
character(:), allocatable :: filename
20+
character(:), allocatable :: filename, last_error
2121
integer(HID_T) :: file_id = 0 !< sentinel value to avoid uninitialized variable lint
22+
integer :: file_mode = -1
2223

2324
logical :: debug = .false.
2425
logical :: fletcher32 = .false.

‎src/read_scalar.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@
3939
!> We only cast when needed to save memory.
4040
!! select case doesn't allow H5T_*
4141
!! 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
42-
if(dclass == H5T_FLOAT_F .OR. dclass == H5T_INTEGER_F) then
42+
if(any(dclass == [H5T_FLOAT_F, H5T_INTEGER_F])) then
4343
select type(A)
4444
type is (real(real64))
4545
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE, A, dims, ier, mem_space_id, file_space_id)

‎src/reader.inc

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ call get_obj_class(self, dname, dset_id, dclass)
2525

2626
!> casting is handled by HDF5 library internally
2727
!! select case doesn't allow H5T_*
28-
if(dclass == H5T_FLOAT_F .OR. dclass == H5T_INTEGER_F) then
28+
if(any(dclass == [H5T_FLOAT_F, H5T_INTEGER_F])) then
2929
select type(A)
3030
type is (real(real64))
3131
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, A, dims, ier, mem_space_id, file_space_id, xfer_id)

‎src/utils.f90

Lines changed: 74 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
h5fget_obj_count_f, h5fget_obj_ids_f, h5fget_name_f, &
99
h5sselect_hyperslab_f, h5screate_simple_f, &
1010
H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, &
11-
H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F, H5F_ACC_TRUNC_F, &
11+
H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F, H5F_ACC_TRUNC_F, H5F_ACC_EXCL_F, &
1212
H5F_OBJ_FILE_F, H5F_OBJ_GROUP_F, H5F_OBJ_DATASET_F, H5F_OBJ_DATATYPE_F, H5F_OBJ_ALL_F, &
1313
H5D_CONTIGUOUS_F, H5D_CHUNKED_F, H5D_COMPACT_F, &
1414
H5I_FILE_F, &
@@ -35,27 +35,77 @@
3535

3636
module procedure h5open
3737

38-
character(2) :: laction
3938
integer :: ier
4039
integer(HID_T) :: fapl !< file access property list
41-
integer :: file_mode
4240

4341
if(present(ok)) ok = .true.
4442

43+
if(present(debug)) self%debug = debug
44+
4545
if(self%is_open()) then
46-
write(stderr, '(a)') 'NOTICE:h5fortran:open: file handle already open: '//self%filename
46+
write(stderr, '(a)') 'NOTICE:h5fortran:open: file handle already open: '//filename
4747
return
4848
endif
4949

50-
laction = 'r'
51-
if (present(action)) laction = action
50+
!> Initialize FORTRAN interface
51+
!! HDF5 1.14.0 introduced bug that if H5open_f is called more than once,
52+
!! it will error.
53+
if (.not. hdf5_is_initialized()) then
54+
if(self%debug) print '(a)', 'TRACE:h5fortran:h5open: initializing HDF5 library'
55+
call H5open_f(ier)
56+
call estop(ier, 'h5open:H5open HDF5 library initialize', filename, ok=ok)
57+
if (present(ok)) then
58+
if (.not. ok) return
59+
endif
60+
endif
5261

53-
self%filename = filename
62+
!! these enums will all be 0 if h5open_f isn't called first
63+
! print *, "TRACE: H5F_ACC_RDONLY_F = ", H5F_ACC_RDONLY_F
64+
! print *, "TRACE: H5F_ACC_RDWR_F = ", H5F_ACC_RDWR_F
65+
! print *, "TRACE: H5F_ACC_TRUNC_F = ", H5F_ACC_TRUNC_F
5466

55-
if(present(debug)) self%debug = debug
67+
if (present(action)) then
68+
select case(action)
69+
case('r')
70+
self%file_mode = H5F_ACC_RDONLY_F
71+
case('r+')
72+
self%file_mode = H5F_ACC_RDWR_F
73+
case('rw', 'a')
74+
if(is_hdf5(filename)) then
75+
self%file_mode = H5F_ACC_RDWR_F
76+
else
77+
self%file_mode = H5F_ACC_TRUNC_F
78+
endif
79+
case ('w')
80+
self%file_mode = H5F_ACC_TRUNC_F
81+
case default
82+
call estop(ier, 'ERROR:h5fortran:open Unsupported action=' // action, filename, ok=ok)
83+
if (present(ok)) then
84+
if(.not. ok) return
85+
endif
86+
end select
87+
elseif (allocated(self%filename)) then
88+
if(self%filename == filename .and. any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then
89+
if(self%debug) print '(3a,i0)', 'NOTICE:h5fortran:open: ', filename, ' reusing file mode ', self%file_mode
90+
else
91+
if (self%debug) print '(a)', 'TRACE:h5fortran:open: opening file: '//filename // &
92+
' read only as this is a different filename than previously used with this file handle'
93+
self%file_mode = H5F_ACC_RDONLY_F
94+
endif
95+
else
96+
if (self%debug) print '(a)', 'TRACE:h5fortran:open: opening file: '//filename // &
97+
' read only as no file mode is specified and no previous file handle exists'
98+
self%file_mode = H5F_ACC_RDONLY_F
99+
endif
100+
101+
102+
103+
self%filename = filename
104+
!! do this AFTER the action= switch
56105

57106
!> compression parameter
58-
if(present(comp_lvl) .and. laction /= "r") self%comp_lvl = comp_lvl
107+
if(present(comp_lvl) .and. self%file_mode /= H5F_ACC_RDONLY_F) self%comp_lvl = comp_lvl
108+
59109
if(self%comp_lvl > 0) then
60110
self%shuffle = .true.
61111
self%fletcher32 = .true.
@@ -72,75 +122,41 @@
72122
self%comp_lvl = 9
73123
endif
74124

75-
!> Initialize FORTRAN interface
76-
!! HDF5 1.14.0 introduced bug that if H5open_f is called more than once,
77-
!! it will error.
78-
if (.not. hdf5_is_initialized()) then
79-
if(self%debug) print '(a)', 'TRACE:h5fortran:h5open: initializing HDF5 library'
80-
call H5open_f(ier)
81-
call estop(ier, 'h5open:H5open HDF5 library initialize', filename, ok=ok)
82-
if (present(ok)) then
83-
if (.not. ok) return
84-
endif
85-
endif
86-
87125
if(self%debug) then
88126
call H5Eset_auto_f(1, ier)
89127
else
90128
call H5Eset_auto_f(0, ier)
91129
endif
92-
call estop(ier, 'h5open:H5Eset_auto: HDF5 library set traceback', filename, ok=ok)
130+
call estop(ier, 'h5open:H5Eset_auto: HDF5 library set traceback', self%filename, ok=ok)
93131
if (present(ok)) then
94132
if(.not. ok) return
95133
endif
96134

97-
select case(laction)
98-
case('r')
99-
file_mode = H5F_ACC_RDONLY_F
100-
case('r+')
101-
file_mode = H5F_ACC_RDWR_F
102-
case('rw', 'a')
103-
if(is_hdf5(filename)) then
104-
file_mode = H5F_ACC_RDWR_F
105-
else
106-
file_mode = H5F_ACC_TRUNC_F
107-
endif
108-
case ('w')
109-
file_mode = H5F_ACC_TRUNC_F
110-
case default
111-
call estop(ier, 'ERROR:h5fortran:open Unsupported action ' // laction, filename, ok=ok)
112-
if (present(ok)) then
113-
if(.not. ok) return
114-
endif
115-
116-
end select
117-
118135
fapl = H5P_DEFAULT_F
119136

120-
!! these enums will all be 0 if h5open_f isn't called first
121-
! print *, "TRACE: file_mode = ", file_mode, " filename = ", filename
122-
! print *, "TRACE: H5F_ACC_RDONLY_F = ", H5F_ACC_RDONLY_F
123-
! print *, "TRACE: H5F_ACC_RDWR_F = ", H5F_ACC_RDWR_F
124-
! print *, "TRACE: H5F_ACC_TRUNC_F = ", H5F_ACC_TRUNC_F
125-
126-
127-
if (file_mode == H5F_ACC_RDONLY_F .or. file_mode == H5F_ACC_RDWR_F) then
137+
if (any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then
128138
if(.not. is_hdf5(filename)) then
129-
error stop "ERROR:h5fortran:open: action=" // laction // " not an HDF5 file: " // filename
139+
write(stderr, '(a,i0)') "ERROR:h5fortran:open: is not an HDF5 file: " // self%filename // " file mode ", self%file_mode
140+
if (present(ok)) then
141+
ok = .false.
142+
return
143+
else
144+
error stop
145+
endif
130146
endif
131-
call H5Fopen_f(filename, file_mode, self%file_id, ier, access_prp=fapl)
132-
call estop(ier, "h5open:H5Fopen", filename, ok=ok)
147+
call H5Fopen_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl)
148+
call estop(ier, "h5open:H5Fopen", self%filename, ok=ok)
133149
if (present(ok)) then
134150
if(.not. ok) return
135151
endif
136-
elseif(file_mode == H5F_ACC_TRUNC_F) then
137-
call H5Fcreate_f(filename, file_mode, self%file_id, ier, access_prp=fapl)
138-
call estop(ier, "h5open:H5Fcreate", filename, ok=ok)
152+
elseif(self%file_mode == H5F_ACC_TRUNC_F) then
153+
call H5Fcreate_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl)
154+
call estop(ier, "h5open:H5Fcreate", self%filename, ok=ok)
139155
if (present(ok)) then
140156
if(.not. ok) return
141157
endif
142158
else
143-
error stop "ERROR:h5fortran:open: Unsupported file mode: " // filename
159+
error stop "ERROR:h5fortran:open: Unsupported file mode: " // self%filename
144160
endif
145161

146162
end procedure h5open
@@ -200,8 +216,6 @@
200216
call H5Fclose_f(self%file_id, ierr)
201217
call estop(ierr, "h5close:H5Fclose: HDF5 file close", self%filename)
202218

203-
deallocate(self%filename)
204-
205219
if (present(close_hdf5_interface)) then
206220
if (close_hdf5_interface) then
207221
call H5close_f(ierr)

0 commit comments

Comments
 (0)