diff --git a/API.md b/API.md index 780f301..0e3c34f 100644 --- a/API.md +++ b/API.md @@ -300,6 +300,32 @@ class(*), intent(out) :: attrval(:) !< character, real, integer call h%delete_attr(dname, attr) ``` +## Iterate over all datasets in a group + +```fortran +call h%iterate(group, callback) + +character(*), intent(in) :: group +subroutine callback(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + character(len=*), intent(in) :: object_name + character(len=*), intent(in) :: object_type +end subroutine +``` + +## Visit recursively all datasets starting from a group + +```fortran +call h%visit(group, callback) + +character(*), intent(in) :: group +subroutine callback(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + character(len=*), intent(in) :: object_name + character(len=*), intent(in) :: object_type +end subroutine +``` + ## high level operations These are single-call operations that are slower than the object-oriented methods above. diff --git a/fpm.toml b/fpm.toml index 40885bf..4eb25d0 100644 --- a/fpm.toml +++ b/fpm.toml @@ -8,9 +8,6 @@ auto-tests = false auto-examples = false external-modules = ["hdf5", "h5lt"] -[dependencies] -hdf5 = "*" - [install] library = true @@ -74,6 +71,17 @@ main = "test_shape.f90" name = "string" main = "test_string.f90" +[[test]] +name = "visit" +main = "test_visit.f90" + +[[test]] +name = "iterate" +main = "test_iterate.f90" + [[test]] name = "version" main = "test_version.f90" + +[dependencies] +hdf5 = '*' diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 94ffe9d..541e306 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -9,4 +9,6 @@ ${s}/interface.f90 ${s}/attr.f90 ${s}/attr_read.f90 ${s}/attr_write.f90 +${s}/iterate.f90 +${s}/visit.f90 ) diff --git a/src/interface.f90 b/src/interface.f90 index 7cabdc3..f75f655 100644 --- a/src/interface.f90 +++ b/src/interface.f90 @@ -56,6 +56,8 @@ module h5fortran procedure, public :: is_open procedure, public :: delete_attr => attr_delete procedure, public :: exist_attr => attr_exist +procedure, public :: iterate => hdf_iterate +procedure, public :: visit => hdf_visit !! procedures without mapping !> below are procedure that need generic mapping (type or rank agnostic) @@ -646,6 +648,58 @@ module logical function attr_exist(self, obj_name, attr_name) character(*), intent(in) :: obj_name, attr_name end function +module subroutine hdf_iterate(self, group_name, callback) + !! Opens the HDF5 file and the specified group, then iterates over + !! all members of the group. For each member the user‐provided + !! callback is invoked with: + !! + !! group_name - name of the group + !! object_name - name of the member object + !! object_type - a short string indicating type ("group", "dataset", + !! "datatype", or "other") + class(hdf5_file), intent(in) :: self + character(len=*), intent(in) :: group_name + interface + subroutine user_callback_interface(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + !! The name of the group being traversed. + character(len=*), intent(in) :: object_name + !! The name of the object encountered. + character(len=*), intent(in) :: object_type + !!A short description such as "group", "dataset", + !! "datatype", or "other" + end subroutine + end interface + + procedure(user_callback_interface) :: callback +end subroutine + +module subroutine hdf_visit(self, group_name, callback) + !! Opens the HDF5 file and the specified group, then visits recursively + !! all members of the group. For each member the user‐provided + !! callback is invoked with: + !! + !! group_name - name of the group + !! object_name - name of the member object + !! object_type - a short string indicating type ("group", "dataset", + !! "datatype", or "other") + class(hdf5_file), intent(in) :: self + character(len=*), intent(in) :: group_name + interface + subroutine user_callback_interface(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + !! The name of the group being traversed. + character(len=*), intent(in) :: object_name + !! The name of the object encountered. + character(len=*), intent(in) :: object_type + !!A short description such as "group", "dataset", + !! "datatype", or "other" + end subroutine + end interface + + procedure(user_callback_interface) :: callback +end subroutine + end interface diff --git a/src/iterate.f90 b/src/iterate.f90 new file mode 100644 index 0000000..0bebf1c --- /dev/null +++ b/src/iterate.f90 @@ -0,0 +1,112 @@ +submodule (h5fortran) iterate_smod + use hdf5 + implicit none + + interface + subroutine user_callback_interface(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + !! The name of the group being traversed. + character(len=*), intent(in) :: object_name + !! The name of the object encountered. + character(len=*), intent(in) :: object_type + !!A short description such as "group", "dataset", + !! "datatype", or "other" + end subroutine + end interface + +contains + + module procedure hdf_iterate + use, intrinsic :: iso_c_binding, only: c_funptr, C_NULL_PTR, c_int + implicit none + integer(hid_t) :: group_id + integer(c_int) :: status + integer(hsize_t) :: idx + type(c_funptr) :: funptr + type(c_ptr) :: op_data_ptr + integer(c_int) :: return_value + procedure(user_callback_interface), pointer :: user_callback => null() + + ! Fill the iteration data with the user’s group name and callback. + user_callback => callback + + ! Open the group. + call H5Gopen_f(self%file_id, trim(group_name), group_id, status) + call estop(status, "hdf_iterate:H5Gopen_f", self%filename, "Error opening group: " // trim(group_name)) + + idx = 0 + op_data_ptr = C_NULL_PTR + ! Get the C function pointer for our internal callback. + funptr = c_funloc(internal_iterate_callback) + + ! Call H5Literate_f to iterate over the group. + call H5Literate_f(group_id, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, idx, & + funptr, op_data_ptr, return_value, status) + call estop(status, "hdf_iterate:H5Literate_f", self%filename, "Error during iteration of group: " // trim(group_name)) + + ! Close the group and file. + call H5Gclose_f(group_id, status) + + contains + + integer(c_int) function internal_iterate_callback(grp_id, name, info, op_data) bind(C) + !! internal_iterate_callback: + !! + !! This is the callback procedure that will be passed to H5Literate_f. + !! It matches HDF5’s expected signature (using bind(C)) and is called + !! for each object in the group. + !! + !! It extracts the object name from the provided character array, + !! calls H5Oget_info_by_name_f to determine the object type, and then + !! calls the user's callback with the high-level parameters. + use ISO_C_BINDING, only: c_int, c_long, c_ptr, c_null_char + implicit none + integer(c_long), value :: grp_id + character(kind=c_char, len=1) :: name(0:255) + type(h5l_info_t) :: info + type(c_ptr) :: op_data + + integer :: status, i, len + integer(hid_t) :: loc_id + type(H5O_info_t) :: infobuf + character(len=256) :: name_string + character(:), allocatable :: object_type + + ! FIXME - This is a workaround for the Fortran unused variable warning/error. + if (info % type == info % type) continue + if (c_associated(op_data)) continue + + ! Build a Fortran string from the character array. + do i = 0, 255 + len = i + if (name(i) == c_null_char) exit + name_string(i+1:i+1) = name(i)(1:1) + end do + + ! Retrieve object info using the object name. + loc_id = int(grp_id, kind=hid_t) + call H5Oget_info_by_name_f(loc_id, name_string(1:len), infobuf, status) + if (status /= 0) then + internal_iterate_callback = status + return + end if + + if(infobuf % type == H5O_TYPE_GROUP_F)then + object_type = "group" + else if(infobuf % type == H5O_TYPE_DATASET_F)then + object_type = "dataset" + else if(infobuf % type == H5O_TYPE_NAMED_DATATYPE_F)then + object_type = "datatype" + else + object_type = "other" + endif + + ! Call the user’s callback procedure. + call user_callback(group_name, name_string(1:len), object_type) + + internal_iterate_callback = 0 ! Indicate success. + end function internal_iterate_callback + + end procedure hdf_iterate + +end submodule diff --git a/src/visit.f90 b/src/visit.f90 new file mode 100644 index 0000000..59abad3 --- /dev/null +++ b/src/visit.f90 @@ -0,0 +1,112 @@ +submodule (h5fortran) visit_smod + use hdf5 + implicit none + + interface + subroutine user_callback_interface(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name + !! The name of the group being traversed. + character(len=*), intent(in) :: object_name + !! The name of the object encountered. + character(len=*), intent(in) :: object_type + !!A short description such as "group", "dataset", + !! "datatype", or "other" + end subroutine + end interface + +contains + + module procedure hdf_visit + use, intrinsic :: iso_c_binding, only: c_funptr, C_NULL_PTR, c_int + implicit none + integer(hid_t) :: group_id + integer(c_int) :: status + integer(hsize_t) :: idx + type(c_funptr) :: funptr + type(c_ptr) :: op_data_ptr + integer(c_int) :: return_value + procedure(user_callback_interface), pointer :: user_callback => null() + + ! Fill the iteration data with the user’s group name and callback. + user_callback => callback + + ! Open the group. + call H5Gopen_f(self%file_id, trim(group_name), group_id, status) + call estop(status, "hdf_visit:H5Gopen_f", self%filename, "Error opening group: " // trim(group_name)) + + idx = 0 + op_data_ptr = C_NULL_PTR + ! Get the C function pointer for our internal callback. + funptr = c_funloc(internal_visit_callback) + + ! Call H5Lvisit_f to visit over the group. + call H5Ovisit_f(group_id, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, & + funptr, op_data_ptr, return_value, status) + call estop(status, "hdf_visit:H5Lvisit_f", self%filename, "Error during iteration of group: " // trim(group_name)) + + ! Close the group and file. + call H5Gclose_f(group_id, status) + + contains + + integer(c_int) function internal_visit_callback(grp_id, name, info, op_data) bind(C) + !! internal_visit_callback: + !! + !! This is the callback procedure that will be passed to H5Lvisit_f. + !! It matches HDF5’s expected signature (using bind(C)) and is called + !! for each object in the group. + !! + !! It extracts the object name from the provided character array, + !! calls H5Oget_info_by_name_f to determine the object type, and then + !! calls the user's callback with the high-level parameters. + use ISO_C_BINDING, only: c_int, c_long, c_ptr, c_null_char + implicit none + integer(c_long), value :: grp_id + character(kind=c_char, len=1) :: name(0:255) + type(h5l_info_t) :: info + type(c_ptr) :: op_data + + integer :: status, i, len + integer(hid_t) :: loc_id + type(H5O_info_t) :: infobuf + character(len=256) :: name_string + character(:), allocatable :: object_type + + ! FIXME - This is a workaround for the Fortran unused variable warning/error. + if (info % type == info % type) continue + if (c_associated(op_data)) continue + + ! Build a Fortran string from the character array. + do i = 0, 255 + len = i + if (name(i) == c_null_char) exit + name_string(i+1:i+1) = name(i)(1:1) + end do + + ! Retrieve object info using the object name. + loc_id = int(grp_id, kind=hid_t) + call H5Oget_info_by_name_f(loc_id, name_string(1:len), infobuf, status) + if (status /= 0) then + internal_visit_callback = status + return + end if + + if(infobuf % type == H5O_TYPE_GROUP_F)then + object_type = "group" + else if(infobuf % type == H5O_TYPE_DATASET_F)then + object_type = "dataset" + else if(infobuf % type == H5O_TYPE_NAMED_DATATYPE_F)then + object_type = "datatype" + else + object_type = "other" + endif + + ! Call the user’s callback procedure. + call user_callback(group_name, name_string(1:len), object_type) + + internal_visit_callback = 0 ! Indicate success. + end function internal_visit_callback + + end procedure hdf_visit + +end submodule diff --git a/src/write.f90 b/src/write.f90 index 0ef30f5..03cf298 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -106,7 +106,8 @@ allocate(ddims(drank), maxdims(drank)) call H5Sget_simple_extent_dims_f(filespace_id, ddims, maxdims, ier) - if (ier /= drank) error stop 'ERROR:h5fortran:create: H5Sget_simple_extent_dims: ' // dname // ' in ' // self%filename + if (ier /= drank) & + error stop 'ERROR:h5fortran:create: H5Sget_simple_extent_dims: ' // dname // ' in ' // self%filename do i = 1, drank if (iend(i) - istart(i) > ddims(i)) emsg = 'ERROR:h5fortran:create: iend - istart > dset_dims' diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index cabdad1..e8a3bee 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -60,7 +60,7 @@ endfunction(setup_test) set(test_names array attributes attributes_read cast deflate_write deflate_read deflate_props destructor exist groups layout lt scalar shape string string_read version write -fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable) +fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit) if(HAVE_IEEE_ARITH) list(APPEND test_names fill) endif() diff --git a/test/test_iterate.f90 b/test/test_iterate.f90 new file mode 100644 index 0000000..4351c3a --- /dev/null +++ b/test/test_iterate.f90 @@ -0,0 +1,48 @@ +program test_iterate + use, intrinsic :: iso_fortran_env, only: real64 + use h5fortran + use hdf5 + implicit none + + type(hdf5_file) :: h + character(*), parameter :: filename='test_iterate.h5' + integer :: i + + i = 0 + + ! Create a sample HDF5 file + call h%open(filename, "w") + + call h%create_group("/group1") + call h%create_group("/group1/group2") + call h%write("/dataset1", 1.0_real64) + call h%write("/group1/dataset2", 2.0_real64) + + call h%close() + + ! Reopen the file for testing + call h%open(filename, "r") + + ! iterate the root group + print*, "test_iterate: iterating root group" + call h%iterate("/", my_callback) + + print*, "test_iterate: iterating /group1" + ! iterate a subgroup + call h%iterate("/group1", my_callback) + + call h%close() + + print*, "test_iterate: found ", i, " objects" + if (i /= 4) error stop "test_iterate: expected 4 objects" + +contains + + ! Define a callback subroutine + subroutine my_callback(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name, object_name, object_type + print *, "test_iterate: at group ", trim(group_name), ' we found ', trim(object_name), ' which is a ', trim(object_type) + i = i + 1 + end subroutine my_callback + +end program test_iterate diff --git a/test/test_visit.f90 b/test/test_visit.f90 new file mode 100644 index 0000000..172cfe4 --- /dev/null +++ b/test/test_visit.f90 @@ -0,0 +1,48 @@ +program test_visit + use, intrinsic :: iso_fortran_env, only: real64 + use h5fortran + use hdf5 + implicit none + + type(hdf5_file) :: h + character(*), parameter :: filename='test_visit.h5' + integer :: i + + i = 0 + + ! Create a sample HDF5 file + call h%open(filename, "w") + + call h%create_group("/group1") + call h%create_group("/group1/group2") + call h%write("/dataset1", 1.0_real64) + call h%write("/group1/dataset2", 2.0_real64) + + call h%close() + + ! Reopen the file for testing + call h%open(filename, "r") + + ! visit the root group + print*, "test_visit: visiting root group" + call h%visit("/", my_callback) + + print*, "test_visit: visiting /group1" + ! visit a subgroup + call h%visit("/group1", my_callback) + + call h%close() + + print*, "test_visit: found ", i, " objects" + if (i /= 8) error stop "test_visit: expected 8 objects" + +contains + + ! Define a callback subroutine + subroutine my_callback(group_name, object_name, object_type) + character(len=*), intent(in) :: group_name, object_name, object_type + print *, "test_visit: at group ", trim(group_name), ' we found ', trim(object_name), ' that is a ', trim(object_type) + i = i + 1 + end subroutine my_callback + +end program test_visit