Skip to content

Commit 0cf897b

Browse files
scivision14NGiestas
scivision
and
14NGiestas
committed
add %iterate method()
Co-authored-by: 14NGiestas <[email protected]>
1 parent 95b0f71 commit 0cf897b

File tree

5 files changed

+191
-1
lines changed

5 files changed

+191
-1
lines changed

‎src/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ set(s ${CMAKE_CURRENT_SOURCE_DIR})
22

33
target_sources(h5fortran PRIVATE
44
${s}/utils.f90 ${s}/datatype.f90 ${s}/deflate.f90
5+
${s}/iterate.f90
56
${s}/read.f90 ${s}/read_scalar.f90 ${s}/read_ascii.f90 ${s}/reader.f90
67
${s}/write.f90 ${s}/write_scalar.f90 ${s}/writer.f90
78
${s}/reader_lt.f90 ${s}/writer_lt.f90

‎src/interface.f90

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,8 @@ module h5fortran
5656
procedure, public :: is_open
5757
procedure, public :: delete_attr => attr_delete
5858
procedure, public :: exist_attr => attr_exist
59+
procedure, public :: iterate => hdf_iterate
60+
5961
!! procedures without mapping
6062

6163
!> below are procedure that need generic mapping (type or rank agnostic)
@@ -774,6 +776,33 @@ module pure subroutine estop(ier, id, filename, obj_name, attr_name)
774776
character(*), intent(in), optional :: obj_name, attr_name
775777
end subroutine
776778

779+
module subroutine hdf_iterate(self, group_name, callback)
780+
!! Opens the HDF5 file and the specified group, then iterates over
781+
!! all members of the group. For each member the user‐provided
782+
!! callback is invoked with:
783+
!!
784+
!! self - the HDF5 file object
785+
!! group_name - name of the group
786+
!! object_name - name of the member object
787+
!! object_type - a short string indicating type ("group", "dataset",
788+
!! "datatype", or "other")
789+
class(hdf5_file), intent(in) :: self
790+
character(*), intent(in) :: group_name
791+
interface
792+
subroutine user_callback_interface(group_name, object_name, object_type)
793+
character(*), intent(in) :: group_name
794+
!! The name of the group being traversed.
795+
character(*), intent(in) :: object_name
796+
!! The name of the object encountered.
797+
character(*), intent(in) :: object_type
798+
!!A short description such as "group", "dataset",
799+
!! "datatype", or "other"
800+
end subroutine
801+
end interface
802+
803+
procedure(user_callback_interface) :: callback
804+
end subroutine
805+
777806
end interface
778807

779808

‎src/iterate.f90

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
submodule (h5fortran:hdf5_read) iterate_smod
2+
use hdf5, only : H5Literate_f, h5l_info_t, H5O_info_t, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, &
3+
H5Gopen_f, H5Gclose_f, H5Oget_info_by_name_f, H5O_TYPE_GROUP_F, &
4+
H5O_TYPE_DATASET_F, H5O_TYPE_NAMED_DATATYPE_F
5+
use, intrinsic :: iso_c_binding, only: c_char, c_long, c_funloc
6+
7+
implicit none
8+
9+
interface
10+
subroutine user_callback_interface(group_name, object_name, object_type)
11+
character(*), intent(in) :: group_name
12+
!! The name of the group being traversed.
13+
character(*), intent(in) :: object_name
14+
!! The name of the object encountered.
15+
character(*), intent(in) :: object_type
16+
!!A short description such as "group", "dataset",
17+
!! "datatype", or "other"
18+
end subroutine
19+
end interface
20+
21+
type :: iterate_data_t
22+
procedure(user_callback_interface), nopass, pointer :: callback => null()
23+
end type iterate_data_t
24+
25+
contains
26+
27+
module procedure hdf_iterate
28+
use, intrinsic :: iso_c_binding, only: c_funptr, C_NULL_PTR, c_int
29+
implicit none
30+
integer(hid_t) :: group_id
31+
integer(c_int) :: status
32+
integer(hsize_t) :: idx
33+
type(c_funptr) :: funptr
34+
type(c_ptr) :: op_data_ptr
35+
integer(c_int) :: return_value
36+
37+
type(iterate_data_t) :: data
38+
39+
! Fill the iteration data with the user’s group name and callback.
40+
data % callback => callback
41+
42+
! Open the group.
43+
call H5Gopen_f(self%file_id, trim(group_name), group_id, status)
44+
call estop(status, "hdf_iterate:H5Gopen_f", self%filename, "Error opening group: " // trim(group_name))
45+
46+
idx = 0
47+
op_data_ptr = C_NULL_PTR
48+
! Get the C function pointer for our internal callback.
49+
funptr = c_funloc(internal_iterate_callback)
50+
51+
! Call H5Literate_f to iterate over the group.
52+
call H5Literate_f(group_id, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, idx, &
53+
funptr, op_data_ptr, return_value, status)
54+
call estop(status, "hdf_iterate:H5Literate_f", self%filename, "Error during iteration of group: " // trim(group_name))
55+
56+
! Close the group and file.
57+
call H5Gclose_f(group_id, status)
58+
59+
contains
60+
61+
integer(c_int) function internal_iterate_callback(grp_id, name, info, op_data) bind(C)
62+
!! internal_iterate_callback:
63+
!!
64+
!! This is the callback procedure that will be passed to H5Literate_f.
65+
!! It matches HDF5’s expected signature (using bind(C)) and is called
66+
!! for each object in the group.
67+
!!
68+
!! It extracts the object name from the provided character array,
69+
!! calls H5Oget_info_by_name_f to determine the object type, and then
70+
!! calls the user's callback with the high-level parameters.
71+
use ISO_C_BINDING, only: c_int, c_ptr, c_null_char
72+
implicit none
73+
integer(c_long), value :: grp_id
74+
character(kind=c_char, len=1) :: name(0:255)
75+
type(h5l_info_t) :: info
76+
type(c_ptr) :: op_data
77+
78+
integer :: status, i, len
79+
type(H5O_info_t) :: infobuf
80+
character(len=256) :: name_string
81+
character(:), allocatable :: object_type
82+
83+
! Build a Fortran string from the character array.
84+
do i = 0, 255
85+
len = i
86+
if (name(i) == c_null_char) exit
87+
name_string(i+1:i+1) = name(i)(1:1)
88+
end do
89+
90+
! Retrieve object info using the object name.
91+
call H5Oget_info_by_name_f(grp_id, name_string(1:len), infobuf, status)
92+
if (status /= 0) then
93+
internal_iterate_callback = status
94+
return
95+
end if
96+
97+
if(infobuf % type == H5O_TYPE_GROUP_F)then
98+
object_type = "group"
99+
else if(infobuf % type == H5O_TYPE_DATASET_F)then
100+
object_type = "dataset"
101+
else if(infobuf % type == H5O_TYPE_NAMED_DATATYPE_F)then
102+
object_type = "datatype"
103+
else
104+
object_type = "other"
105+
endif
106+
107+
! Call the user’s callback procedure.
108+
call data % callback(group_name, name_string(1:len), object_type)
109+
110+
internal_iterate_callback = 0 ! Indicate success.
111+
end function internal_iterate_callback
112+
113+
end procedure hdf_iterate
114+
115+
end submodule

‎test/CMakeLists.txt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ endfunction(setup_test)
5959

6060
set(test_names array attributes attributes_read
6161
cast deflate_write deflate_read deflate_props destructor exist
62-
groups layout lt scalar shape string string_read version write
62+
groups iterate layout lt scalar shape string string_read version write
6363
fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable)
6464
if(HAVE_IEEE_ARITH)
6565
list(APPEND test_names fill)

‎test/test_iterate.f90

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
program test_iterate
2+
use, intrinsic :: iso_fortran_env, only: real64
3+
use h5fortran, only: hdf5_file
4+
implicit none
5+
6+
type(hdf5_file) :: h
7+
character(*), parameter :: filename='test_iterate.h5'
8+
integer :: i = 0
9+
10+
! Create a sample HDF5 file
11+
call h%open(filename, "w")
12+
13+
call h%create_group("/group1")
14+
call h%create_group("/group1/group2")
15+
call h%write("/dataset1", 1.0_real64)
16+
call h%write("/group1/dataset2", 2.0_real64)
17+
18+
call h%close()
19+
20+
! Reopen the file for testing
21+
call h%open(filename, "r")
22+
23+
! iterate the root group
24+
print*, "test_iterate: iterating root group"
25+
call h%iterate("/", my_callback)
26+
27+
print*, "test_iterate: iterating /group1"
28+
! iterate a subgroup
29+
call h%iterate("/group1", my_callback)
30+
31+
call h%close()
32+
33+
print '(a,i0,a)', "test_iterate: found ", i, " objects"
34+
if (i /= 4) error stop "test_iterate: expected 4 objects"
35+
36+
contains
37+
38+
! Define a callback subroutine
39+
subroutine my_callback(group_name, object_name, object_type)
40+
character(*), intent(in) :: group_name, object_name, object_type
41+
print '(6a)', "test_iterate: at group ", trim(group_name), ' we found ', trim(object_name), ' which is a ', trim(object_type)
42+
i = i + 1
43+
end subroutine my_callback
44+
45+
end program test_iterate

0 commit comments

Comments
 (0)