From 1fc839ba7fcd3419e618e1178140142664cce3c6 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Fri, 7 Feb 2025 16:34:26 -0300 Subject: [PATCH 01/19] In the next release, fpm will support a hdf5 metapackage. --- fpm.toml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/fpm.toml b/fpm.toml index d31b1c1..0b8f66c 100644 --- a/fpm.toml +++ b/fpm.toml @@ -77,3 +77,6 @@ main = "test_string.f90" [[test]] name = "version" main = "test_version.f90" + +[dependencies] +hdf5 = '*' From 932509c04e4b46eec3d483a7e0b2a6f2e219ca16 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Sat, 11 Apr 2026 23:02:45 -0300 Subject: [PATCH 02/19] feat: add iterate and visit methods for HDF5 file traversal - Add iterate and visit procedures for HDF5 file traversal - Add iterate.f90 and visit.f90 source files - Fix line truncation issue in write.f90 - Fix error message typo (filena -> filename) - Add datatype.f90 and deflate.f90 to CMakeLists.txt - Add tests for iterate and visit procedures - Various bugfixes from review --- API.md | 26 ++++++++++ fpm.toml | 8 +++ src/CMakeLists.txt | 8 ++- src/interface.f90 | 54 ++++++++++++++++++++ src/iterate.f90 | 112 ++++++++++++++++++++++++++++++++++++++++++ src/utils.f90 | 5 +- src/visit.f90 | 112 ++++++++++++++++++++++++++++++++++++++++++ src/write.f90 | 17 +++---- test/CMakeLists.txt | 5 +- test/test_iterate.f90 | 48 ++++++++++++++++++ test/test_visit.f90 | 48 ++++++++++++++++++ 11 files changed, 426 insertions(+), 17 deletions(-) create mode 100644 src/iterate.f90 create mode 100644 src/visit.f90 create mode 100644 test/test_iterate.f90 create mode 100644 test/test_visit.f90 diff --git a/API.md b/API.md index 6181f98..1bf4b87 100644 --- a/API.md +++ b/API.md @@ -322,6 +322,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 0b8f66c..8379389 100644 --- a/fpm.toml +++ b/fpm.toml @@ -74,6 +74,14 @@ 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" diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 94ffe9d..f710817 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,12 +1,16 @@ set(s ${CMAKE_CURRENT_SOURCE_DIR}) target_sources(h5fortran PRIVATE -${s}/utils.f90 ${s}/datatype.f90 ${s}/deflate.f90 +${s}/interface.f90 +${s}/utils.f90 +${s}/datatype.f90 +${s}/deflate.f90 ${s}/read.f90 ${s}/read_scalar.f90 ${s}/read_ascii.f90 ${s}/reader.f90 ${s}/write.f90 ${s}/write_scalar.f90 ${s}/writer.f90 ${s}/reader_lt.f90 ${s}/writer_lt.f90 -${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 12963ad..c4d18bb 100644 --- a/src/interface.f90 +++ b/src/interface.f90 @@ -57,6 +57,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) @@ -649,6 +651,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/utils.f90 b/src/utils.f90 index b366b2b..df88d01 100644 --- a/src/utils.f90 +++ b/src/utils.f90 @@ -366,8 +366,9 @@ write(stderr,*) "ERROR:h5fortran:get_slice: memory size /= dataset size: check variable slice (index). " // & " Dset_dims:", ddims, "C Mem_dims:", c_mem_dims, "mem_dims:", mem_dims, "rank(mem_dims):", rank(mem_dims) error stop "ERROR:h5fortran:get_slice " // dset_name -elseif(any(iend-istart+1 > ddims)) then - write(stderr,*) "ERROR:h5fortran:get_slice: iend: ", iend, ' > dset_dims: ', ddims +elseif(any(iend-istart > ddims)) then + write(stderr,*) "ERROR:h5fortran:get_slice: slice bigger than dataset: check variable slice (index). " // & + " Dset_dims:", ddims, "C Mem_dims:", c_mem_dims, "mem_dims:", mem_dims, "rank(mem_dims):", rank(mem_dims) error stop "ERROR:h5fortran:get_slice " // dset_name endif 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 87320f6..afe2afe 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -91,7 +91,9 @@ call estop(ier, "create:H5Dget_space", self%filename, dname) - if (present(istart) .and. present(iend)) then + if (present(istart)) then + if(any(istart < 1)) error stop 'ERROR:h5fortran:create: istart must be >= 1' + if(any(iend < istart)) error stop 'ERROR:h5fortran:create: iend must be >= istart' call H5Sget_simple_extent_ndims_f(filespace_id, drank, ier) call estop(ier, "create:H5Sget_simple_extent_ndims", self%filename, dname) @@ -116,17 +118,14 @@ 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' - enddo - if (allocated(emsg)) then - write(stderr,*) emsg // " dataset: " // dname // " file: " // self%filename // " istart: ", & - istart, " iend: ", iend, " ddims: ", ddims, " maxdims: ", maxdims + if(any(iend - istart > ddims)) then + write(stderr,*) 'ERROR:h5fortran:create: iend - istart > dset_dims dataset: ', dname, & + ' file: ', self%filename, ' istart: ', istart, ' iend: ', iend, ' ddims: ', ddims error stop endif - else if (size(mem_dims) == 0) then !! scalar diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 84a05fa..cc2b87f 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -74,7 +74,7 @@ endfunction(setup_test) set(test_names array attributes cast deflate_write deflate_read deflate_props destructor exist groups layout lt scalar shape string 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() @@ -113,9 +113,6 @@ endif() if(h5py_ok) -set_property(TEST string_read PROPERTY FIXTURES_REQUIRED h5str) -set_property(TEST string_read PROPERTY REQUIRED_FILES ${string_file}) - add_test(NAME PythonAttributes COMMAND Python::Interpreter ${CMAKE_CURRENT_SOURCE_DIR}/generate_attributes.py ${attr_file} ) 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 From 3cceda894fba912ef230452de7036fc6f20ced7f Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Mon, 13 Apr 2026 05:58:57 -0300 Subject: [PATCH 03/19] fix: resolve ifx segfault and cross-version HDF5 compatibility for iterate/visit Replace HDF5 Fortran wrappers with direct HDF5 Fortran module calls to fix SIGSEGV with Intel ifx and undefined references on older HDF5 versions. Changes: - Use H5Literate_f and H5Ovisit_f Fortran wrappers (version-independent) - Remove C API templates (.f90.in files) and version-specific configure logic - Use H5Oget_info_by_name_f for type detection (handles all HDF5 versions) - Use h5o_info_t from HDF5 Fortran module with H5Ovisit_f callback - Use h5l_info_t from HDF5 Fortran module with H5Literate_f callback - Fix fpm.toml duplicate [dependencies] section - Remove nix shell files (preserved in feature/nix-shells branch) Tested: - GCC 9-15: pass (with -Werror) - Intel ifx: iterate/visit pass without segfault - HDF5 1.10-1.14: pass - fpm: 8 visit objects, 4 iterate objects correct --- .gitignore | 3 ++ CMakeLists.txt | 1 + fpm.toml | 3 -- src/iterate.f90 | 87 +++++++++++++++++++------------------------------ src/visit.f90 | 79 ++++++++++++++------------------------------ 5 files changed, 61 insertions(+), 112 deletions(-) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..37c2b95 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +build/ +.envrc +*.h5 diff --git a/CMakeLists.txt b/CMakeLists.txt index d2ca208..1994127 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -51,6 +51,7 @@ endif() # --- h5fortran library add_library(h5fortran) + target_include_directories(h5fortran PUBLIC $ $ diff --git a/fpm.toml b/fpm.toml index 8379389..b629185 100644 --- a/fpm.toml +++ b/fpm.toml @@ -85,6 +85,3 @@ main = "test_iterate.f90" [[test]] name = "version" main = "test_version.f90" - -[dependencies] -hdf5 = '*' diff --git a/src/iterate.f90 b/src/iterate.f90 index 0bebf1c..b0cecc6 100644 --- a/src/iterate.f90 +++ b/src/iterate.f90 @@ -1,23 +1,19 @@ submodule (h5fortran) iterate_smod use hdf5 + use, intrinsic :: iso_c_binding 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 @@ -27,84 +23,67 @@ subroutine user_callback_interface(group_name, object_name, object_type) 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 + idx = 0_hsize_t 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 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)) + if (return_value < 0) then + call estop(1_c_int, "hdf_iterate:H5Literate", self%filename, "Error during iteration of group: " // trim(group_name)) + end if - ! 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(c_intptr_t), value :: grp_id + character(kind=c_char), intent(in) :: name(*) + type(h5l_info_t), intent(in) :: info + type(c_ptr), value :: op_data - integer :: status, i, len + integer :: i, ln, obj_status integer(hid_t) :: loc_id - type(H5O_info_t) :: infobuf - character(len=256) :: name_string + type(h5o_info_t) :: obj_info + character(len=256) :: name_str character(:), allocatable :: object_type - ! FIXME - This is a workaround for the Fortran unused variable warning/error. - if (info % type == info % type) continue + if (info % corder == info % corder) continue if (c_associated(op_data)) continue - ! Build a Fortran string from the character array. - do i = 0, 255 - len = i + ln = 0 + do i = 1, 256 if (name(i) == c_null_char) exit - name_string(i+1:i+1) = name(i)(1:1) + name_str(i:i) = name(i) + ln = i 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" + loc_id = int(grp_id, hid_t) + call H5Oget_info_by_name_f(loc_id, name_str(1:ln), obj_info, obj_status) + if (obj_status == 0) then + if (obj_info % type == H5O_TYPE_GROUP_F) then + object_type = "group" + else if (obj_info % type == H5O_TYPE_DATASET_F) then + object_type = "dataset" + else if (obj_info % type == H5O_TYPE_NAMED_DATATYPE_F) then + object_type = "datatype" + else + object_type = "other" + end if else object_type = "other" - endif + end if - ! Call the user’s callback procedure. - call user_callback(group_name, name_string(1:len), object_type) + call user_callback(group_name, name_str(1:ln), object_type) - internal_iterate_callback = 0 ! Indicate success. + internal_iterate_callback = 0 end function internal_iterate_callback end procedure hdf_iterate diff --git a/src/visit.f90 b/src/visit.f90 index 59abad3..3920b7e 100644 --- a/src/visit.f90 +++ b/src/visit.f90 @@ -1,110 +1,79 @@ submodule (h5fortran) visit_smod use hdf5 + use, intrinsic :: iso_c_binding 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)) + 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:H5Ovisit_f", self%filename, "Error during visit of group: " // trim(group_name)) + if (return_value < 0) then + call estop(1_c_int, "hdf_visit:H5Ovisit", self%filename, "Error during visit of group: " // trim(group_name)) + end if - ! 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 + integer(c_intptr_t), value :: grp_id + character(kind=c_char), intent(in) :: name(*) + type(h5o_info_t), intent(in) :: info + type(c_ptr), value :: op_data + + character(len=256) :: name_str character(:), allocatable :: object_type + integer :: i, ln - ! FIXME - This is a workaround for the Fortran unused variable warning/error. - if (info % type == info % type) continue + if (grp_id /= 0_c_intptr_t) continue if (c_associated(op_data)) continue - ! Build a Fortran string from the character array. - do i = 0, 255 - len = i + ln = 0 + do i = 1, 256 if (name(i) == c_null_char) exit - name_string(i+1:i+1) = name(i)(1:1) + name_str(i:i) = name(i) + ln = i 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 + if (info % type == H5O_TYPE_GROUP_F) then object_type = "group" - else if(infobuf % type == H5O_TYPE_DATASET_F)then + else if (info % type == H5O_TYPE_DATASET_F) then object_type = "dataset" - else if(infobuf % type == H5O_TYPE_NAMED_DATATYPE_F)then + else if (info % type == H5O_TYPE_NAMED_DATATYPE_F) then object_type = "datatype" else object_type = "other" - endif + end if - ! Call the user’s callback procedure. - call user_callback(group_name, name_string(1:len), object_type) + call user_callback(group_name, name_str(1:ln), object_type) - internal_visit_callback = 0 ! Indicate success. + internal_visit_callback = 0 end function internal_visit_callback end procedure hdf_visit From fb42de00238b4b1b744e259c7481511d36e3b45a Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 09:01:53 -0300 Subject: [PATCH 04/19] feat: add native SWMR support for concurrent read/write --- fpm.toml | 4 ++++ src/interface.f90 | 20 ++++++++++++++++-- src/read.f90 | 21 ++++++++++++++++++- src/utils.f90 | 37 ++++++++++++++++++++++++++++++++- src/write.f90 | 21 ++++++++++++++++++- test/CMakeLists.txt | 2 +- test/test_swmr.f90 | 50 +++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 149 insertions(+), 6 deletions(-) create mode 100644 test/test_swmr.f90 diff --git a/fpm.toml b/fpm.toml index b629185..4a7c50c 100644 --- a/fpm.toml +++ b/fpm.toml @@ -85,3 +85,7 @@ main = "test_iterate.f90" [[test]] name = "version" main = "test_version.f90" + +[[test]] +name = "swmr" +main = "test_swmr.f90" diff --git a/src/interface.f90 b/src/interface.f90 index c4d18bb..6684820 100644 --- a/src/interface.f90 +++ b/src/interface.f90 @@ -24,6 +24,7 @@ module h5fortran logical :: debug = .false. logical :: fletcher32 = .false. logical :: shuffle = .false. +logical :: swmr = .false. integer :: comp_lvl = 0 !! compression level (1-9) 0: disable compression @@ -38,7 +39,10 @@ module h5fortran procedure, public :: write_group => create_group !< legacy procedure, public :: create_group procedure, public :: create => hdf_create_user -procedure, public :: flush => hdf_flush +generic, public :: flush => hdf_flush, hdf_flush_dataset +procedure, private :: hdf_flush +procedure, private :: hdf_flush_dataset +procedure, public :: refresh => hdf_refresh procedure, public :: filesize => hdf_filesize procedure, public :: ndim => hdf_get_ndim procedure, public :: ndims => hdf_get_ndim !< legacy @@ -163,6 +167,12 @@ module subroutine hdf_flush(self) class(hdf5_file), intent(in) :: self end subroutine +module subroutine hdf_flush_dataset(self, dname) +!! request HDF5 to flush dataset to disk. +class(hdf5_file), intent(in) :: self +character(*), intent(in) :: dname +end subroutine + end interface interface !< writer_lt.f90 @@ -399,6 +409,11 @@ module logical function hdf_check_exist(self, obj_name) character(*), intent(in) :: obj_name end function +module subroutine hdf_refresh(self, dname) +class(hdf5_file), intent(in) :: self +character(*), intent(in) :: dname +end subroutine + end interface @@ -714,7 +729,7 @@ module function id2name(id) character(:), allocatable :: id2name end function -module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, debug, ok) +module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, debug, swmr, ok) !! open/create file !! !! PARAMETERS: @@ -730,6 +745,7 @@ module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, logical, intent(in), optional :: shuffle logical, intent(in), optional :: fletcher32 logical, intent(in), optional :: debug +logical, intent(in), optional :: swmr logical, intent(out), optional :: ok end subroutine diff --git a/src/read.f90 b/src/read.f90 index 8616c00..28159e0 100644 --- a/src/read.f90 +++ b/src/read.f90 @@ -5,7 +5,7 @@ use hdf5, only : & H5Aget_space_f, H5Aget_type_f, H5Aopen_by_name_f, H5Aclose_f, H5Aget_storage_size_f, & h5pget_layout_f, h5pget_chunk_f, h5pclose_f, h5pget_nfilters_f, h5pget_filter_f, & -H5Dget_create_plist_f, h5dget_type_f, h5dopen_f, h5dclose_f, H5Dget_space_f, H5Dget_storage_size_f, & +H5Dget_create_plist_f, h5dget_type_f, h5dopen_f, h5dclose_f, H5Dget_space_f, H5Dget_storage_size_f, h5drefresh_f, & H5Iget_type_f, & h5lexists_f, & H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, H5Sclose_f, & @@ -139,4 +139,23 @@ end procedure hdf_check_exist +module procedure hdf_refresh + +integer :: ier +integer(HID_T) :: dset_id + +if(.not. self%is_open()) error stop "ERROR:h5fortran:refresh: file is not open: " // self%filename + +call H5Dopen_f(self%file_id, dname, dset_id, ier) +call estop(ier, "refresh:H5Dopen", self%filename, dname) + +call H5Drefresh_f(dset_id, ier) +call estop(ier, "refresh:H5Drefresh", self%filename, dname) + +call H5Dclose_f(dset_id, ier) +call estop(ier, "refresh:H5Dclose", self%filename, dname) + +end procedure hdf_refresh + + end submodule hdf5_read diff --git a/src/utils.f90 b/src/utils.f90 index df88d01..198e304 100644 --- a/src/utils.f90 +++ b/src/utils.f90 @@ -6,9 +6,14 @@ h5open_f, h5close_f, & H5Fopen_f, h5fcreate_f, h5fclose_f, h5fis_hdf5_f, h5fget_filesize_f, & h5fget_obj_count_f, h5fget_obj_ids_f, h5fget_name_f, & +h5fstart_swmr_write_f, & +h5pcreate_f, h5pclose_f, h5pset_libver_bounds_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_EXCL_F, & +H5F_ACC_SWMR_WRITE_F, H5F_ACC_SWMR_READ_F, & +H5F_LIBVER_LATEST_F, H5F_LIBVER_EARLIEST_F, & +H5P_FILE_ACCESS_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, & @@ -42,6 +47,7 @@ if(present(ok)) ok = .true. if(present(debug)) self%debug = debug +if(present(swmr)) self%swmr = swmr self%filename = filename @@ -126,6 +132,19 @@ fapl = H5P_DEFAULT_F +if (self%swmr) then + call H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, ier) + call estop(ier, "h5open:H5Pcreate", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return + endif + call H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, ier) + call estop(ier, "h5open:H5Pset_libver_bounds", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return + endif +endif + if (any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then if(.not. is_hdf5(filename)) then write(stderr, '(a,i0)') "ERROR:h5fortran:open: is not an HDF5 file: " // self%filename // " file mode ", self%file_mode @@ -136,7 +155,13 @@ error stop endif endif - call H5Fopen_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) + + if (self%swmr .and. self%file_mode == H5F_ACC_RDONLY_F) then + call H5Fopen_f(self%filename, ior(self%file_mode, H5F_ACC_SWMR_READ_F), self%file_id, ier, access_prp=fapl) + else + call H5Fopen_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) + endif + call estop(ier, "h5open:H5Fopen", self%filename, ok=ok) if (present(ok)) then if(.not. ok) return @@ -151,6 +176,16 @@ error stop "ERROR:h5fortran:open: Unsupported file mode: " // self%filename endif +if (self%swmr .and. self%file_mode /= H5F_ACC_RDONLY_F) then + call H5Fstart_swmr_write_f(self%file_id, ier) + call estop(ier, "h5open:H5Fstart_swmr_write", self%filename, ok=ok) +endif + +if (fapl /= H5P_DEFAULT_F) then + call H5Pclose_f(fapl, ier) + call estop(ier, "h5open:H5Pclose", self%filename, ok=ok) +endif + end procedure h5open diff --git a/src/write.f90 b/src/write.f90 index afe2afe..997ce70 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -1,7 +1,7 @@ submodule (h5fortran) write use hdf5, only: & -h5fflush_f, & +h5fflush_f, h5dflush_f, & h5screate_f, h5sclose_f, h5screate_simple_f, H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, & h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, & h5pset_chunk_f, h5pset_layout_f, h5pset_deflate_f, h5pset_shuffle_f, h5pset_fletcher32_f, & @@ -417,4 +417,23 @@ end subroutine guess_chunk_size end procedure hdf_flush +module procedure hdf_flush_dataset + +integer :: ier +integer(HID_T) :: dset_id + +if(.not. self%is_open()) error stop "ERROR:h5fortran:flush: file is not open: " // self%filename + +call H5Dopen_f(self%file_id, dname, dset_id, ier) +call estop(ier, "flush:H5Dopen", self%filename, dname) + +call H5Dflush_f(dset_id, ier) +call estop(ier, "flush:H5Dflush", self%filename, dname) + +call H5Dclose_f(dset_id, ier) +call estop(ier, "flush:H5Dclose", self%filename, dname) + +end procedure hdf_flush_dataset + + end submodule write diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index cc2b87f..163c259 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -74,7 +74,7 @@ endfunction(setup_test) set(test_names array attributes cast deflate_write deflate_read deflate_props destructor exist groups layout lt scalar shape string version write -fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit) +fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit swmr) if(HAVE_IEEE_ARITH) list(APPEND test_names fill) endif() diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 new file mode 100644 index 0000000..9b7943a --- /dev/null +++ b/test/test_swmr.f90 @@ -0,0 +1,50 @@ +program test_swmr + use h5fortran, only: hdf5_file + implicit none + + character(*), parameter :: fn = 'test_swmr.h5' + type(hdf5_file) :: h_write, h_read + integer, parameter :: n = 10 + real :: dat(n), dat_out(n) + integer :: i + + do i = 1, n + dat(i) = real(i) + end do + + ! 1. Writer side + call h_write%open(fn, action='w', swmr=.true.) + call h_write%write('/data', dat) + call h_write%flush('/data') + + ! 2. Reader side (concurrent-ish) + call h_read%open(fn, action='r', swmr=.true.) + call h_read%read('/data', dat_out) + + if (any(dat_out /= dat)) then + print *, 'ERROR: SWMR data mismatch' + stop 1 + end if + + ! 3. Update data + dat = dat * 2.0 + call h_write%write('/data', dat) + call h_write%flush('/data') + + ! 4. Refresh reader + call h_read%refresh('/data') + call h_read%read('/data', dat_out) + + if (any(dat_out /= dat)) then + print *, 'ERROR: SWMR data mismatch after update' + print *, 'Expected:', dat + print *, 'Got: ', dat_out + stop 1 + end if + + call h_read%close() + call h_write%close() + + print *, 'PASSED: SWMR' + +end program test_swmr From 023036a481abe27abd4be2cc37e88a19dd10d221 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 09:01:53 -0300 Subject: [PATCH 05/19] feat: add native SWMR support for concurrent read/write --- fpm.toml | 4 ++++ src/interface.f90 | 20 ++++++++++++++++-- src/read.f90 | 21 ++++++++++++++++++- src/utils.f90 | 37 ++++++++++++++++++++++++++++++++- src/write.f90 | 22 +++++++++++++++++++- test/CMakeLists.txt | 2 +- test/test_swmr.f90 | 50 +++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 150 insertions(+), 6 deletions(-) create mode 100644 test/test_swmr.f90 diff --git a/fpm.toml b/fpm.toml index b629185..4a7c50c 100644 --- a/fpm.toml +++ b/fpm.toml @@ -85,3 +85,7 @@ main = "test_iterate.f90" [[test]] name = "version" main = "test_version.f90" + +[[test]] +name = "swmr" +main = "test_swmr.f90" diff --git a/src/interface.f90 b/src/interface.f90 index c4d18bb..6684820 100644 --- a/src/interface.f90 +++ b/src/interface.f90 @@ -24,6 +24,7 @@ module h5fortran logical :: debug = .false. logical :: fletcher32 = .false. logical :: shuffle = .false. +logical :: swmr = .false. integer :: comp_lvl = 0 !! compression level (1-9) 0: disable compression @@ -38,7 +39,10 @@ module h5fortran procedure, public :: write_group => create_group !< legacy procedure, public :: create_group procedure, public :: create => hdf_create_user -procedure, public :: flush => hdf_flush +generic, public :: flush => hdf_flush, hdf_flush_dataset +procedure, private :: hdf_flush +procedure, private :: hdf_flush_dataset +procedure, public :: refresh => hdf_refresh procedure, public :: filesize => hdf_filesize procedure, public :: ndim => hdf_get_ndim procedure, public :: ndims => hdf_get_ndim !< legacy @@ -163,6 +167,12 @@ module subroutine hdf_flush(self) class(hdf5_file), intent(in) :: self end subroutine +module subroutine hdf_flush_dataset(self, dname) +!! request HDF5 to flush dataset to disk. +class(hdf5_file), intent(in) :: self +character(*), intent(in) :: dname +end subroutine + end interface interface !< writer_lt.f90 @@ -399,6 +409,11 @@ module logical function hdf_check_exist(self, obj_name) character(*), intent(in) :: obj_name end function +module subroutine hdf_refresh(self, dname) +class(hdf5_file), intent(in) :: self +character(*), intent(in) :: dname +end subroutine + end interface @@ -714,7 +729,7 @@ module function id2name(id) character(:), allocatable :: id2name end function -module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, debug, ok) +module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, debug, swmr, ok) !! open/create file !! !! PARAMETERS: @@ -730,6 +745,7 @@ module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, logical, intent(in), optional :: shuffle logical, intent(in), optional :: fletcher32 logical, intent(in), optional :: debug +logical, intent(in), optional :: swmr logical, intent(out), optional :: ok end subroutine diff --git a/src/read.f90 b/src/read.f90 index 8616c00..28159e0 100644 --- a/src/read.f90 +++ b/src/read.f90 @@ -5,7 +5,7 @@ use hdf5, only : & H5Aget_space_f, H5Aget_type_f, H5Aopen_by_name_f, H5Aclose_f, H5Aget_storage_size_f, & h5pget_layout_f, h5pget_chunk_f, h5pclose_f, h5pget_nfilters_f, h5pget_filter_f, & -H5Dget_create_plist_f, h5dget_type_f, h5dopen_f, h5dclose_f, H5Dget_space_f, H5Dget_storage_size_f, & +H5Dget_create_plist_f, h5dget_type_f, h5dopen_f, h5dclose_f, H5Dget_space_f, H5Dget_storage_size_f, h5drefresh_f, & H5Iget_type_f, & h5lexists_f, & H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, H5Sclose_f, & @@ -139,4 +139,23 @@ end procedure hdf_check_exist +module procedure hdf_refresh + +integer :: ier +integer(HID_T) :: dset_id + +if(.not. self%is_open()) error stop "ERROR:h5fortran:refresh: file is not open: " // self%filename + +call H5Dopen_f(self%file_id, dname, dset_id, ier) +call estop(ier, "refresh:H5Dopen", self%filename, dname) + +call H5Drefresh_f(dset_id, ier) +call estop(ier, "refresh:H5Drefresh", self%filename, dname) + +call H5Dclose_f(dset_id, ier) +call estop(ier, "refresh:H5Dclose", self%filename, dname) + +end procedure hdf_refresh + + end submodule hdf5_read diff --git a/src/utils.f90 b/src/utils.f90 index df88d01..198e304 100644 --- a/src/utils.f90 +++ b/src/utils.f90 @@ -6,9 +6,14 @@ h5open_f, h5close_f, & H5Fopen_f, h5fcreate_f, h5fclose_f, h5fis_hdf5_f, h5fget_filesize_f, & h5fget_obj_count_f, h5fget_obj_ids_f, h5fget_name_f, & +h5fstart_swmr_write_f, & +h5pcreate_f, h5pclose_f, h5pset_libver_bounds_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_EXCL_F, & +H5F_ACC_SWMR_WRITE_F, H5F_ACC_SWMR_READ_F, & +H5F_LIBVER_LATEST_F, H5F_LIBVER_EARLIEST_F, & +H5P_FILE_ACCESS_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, & @@ -42,6 +47,7 @@ if(present(ok)) ok = .true. if(present(debug)) self%debug = debug +if(present(swmr)) self%swmr = swmr self%filename = filename @@ -126,6 +132,19 @@ fapl = H5P_DEFAULT_F +if (self%swmr) then + call H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, ier) + call estop(ier, "h5open:H5Pcreate", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return + endif + call H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, ier) + call estop(ier, "h5open:H5Pset_libver_bounds", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return + endif +endif + if (any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then if(.not. is_hdf5(filename)) then write(stderr, '(a,i0)') "ERROR:h5fortran:open: is not an HDF5 file: " // self%filename // " file mode ", self%file_mode @@ -136,7 +155,13 @@ error stop endif endif - call H5Fopen_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) + + if (self%swmr .and. self%file_mode == H5F_ACC_RDONLY_F) then + call H5Fopen_f(self%filename, ior(self%file_mode, H5F_ACC_SWMR_READ_F), self%file_id, ier, access_prp=fapl) + else + call H5Fopen_f(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) + endif + call estop(ier, "h5open:H5Fopen", self%filename, ok=ok) if (present(ok)) then if(.not. ok) return @@ -151,6 +176,16 @@ error stop "ERROR:h5fortran:open: Unsupported file mode: " // self%filename endif +if (self%swmr .and. self%file_mode /= H5F_ACC_RDONLY_F) then + call H5Fstart_swmr_write_f(self%file_id, ier) + call estop(ier, "h5open:H5Fstart_swmr_write", self%filename, ok=ok) +endif + +if (fapl /= H5P_DEFAULT_F) then + call H5Pclose_f(fapl, ier) + call estop(ier, "h5open:H5Pclose", self%filename, ok=ok) +endif + end procedure h5open diff --git a/src/write.f90 b/src/write.f90 index afe2afe..3e3efd4 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -1,9 +1,10 @@ submodule (h5fortran) write use hdf5, only: & -h5fflush_f, & +h5fflush_f, h5oflush_f, & h5screate_f, h5sclose_f, h5screate_simple_f, H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, & h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, & +h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, & h5pset_chunk_f, h5pset_layout_f, h5pset_deflate_f, h5pset_shuffle_f, h5pset_fletcher32_f, & h5pcreate_f, h5pclose_f, h5pset_fill_value_f, & H5P_DATASET_CREATE_F, & @@ -417,4 +418,23 @@ end subroutine guess_chunk_size end procedure hdf_flush +module procedure hdf_flush_dataset + +integer :: ier +integer(HID_T) :: dset_id + +if(.not. self%is_open()) error stop "ERROR:h5fortran:flush: file is not open: " // self%filename + +call H5Dopen_f(self%file_id, dname, dset_id, ier) +call estop(ier, "flush:H5Dopen", self%filename, dname) + +call H5Oflush_f(dset_id, ier) +call estop(ier, "flush:H5Oflush", self%filename, dname) + +call H5Dclose_f(dset_id, ier) +call estop(ier, "flush:H5Dclose", self%filename, dname) + +end procedure hdf_flush_dataset + + end submodule write diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index cc2b87f..163c259 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -74,7 +74,7 @@ endfunction(setup_test) set(test_names array attributes cast deflate_write deflate_read deflate_props destructor exist groups layout lt scalar shape string version write -fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit) +fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit swmr) if(HAVE_IEEE_ARITH) list(APPEND test_names fill) endif() diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 new file mode 100644 index 0000000..9b7943a --- /dev/null +++ b/test/test_swmr.f90 @@ -0,0 +1,50 @@ +program test_swmr + use h5fortran, only: hdf5_file + implicit none + + character(*), parameter :: fn = 'test_swmr.h5' + type(hdf5_file) :: h_write, h_read + integer, parameter :: n = 10 + real :: dat(n), dat_out(n) + integer :: i + + do i = 1, n + dat(i) = real(i) + end do + + ! 1. Writer side + call h_write%open(fn, action='w', swmr=.true.) + call h_write%write('/data', dat) + call h_write%flush('/data') + + ! 2. Reader side (concurrent-ish) + call h_read%open(fn, action='r', swmr=.true.) + call h_read%read('/data', dat_out) + + if (any(dat_out /= dat)) then + print *, 'ERROR: SWMR data mismatch' + stop 1 + end if + + ! 3. Update data + dat = dat * 2.0 + call h_write%write('/data', dat) + call h_write%flush('/data') + + ! 4. Refresh reader + call h_read%refresh('/data') + call h_read%read('/data', dat_out) + + if (any(dat_out /= dat)) then + print *, 'ERROR: SWMR data mismatch after update' + print *, 'Expected:', dat + print *, 'Got: ', dat_out + stop 1 + end if + + call h_read%close() + call h_write%close() + + print *, 'PASSED: SWMR' + +end program test_swmr From d04381c815cab20716009584367517c6acea3ca6 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 09:27:17 -0300 Subject: [PATCH 06/19] fix(nix): enable fortranSupport for HDF5 in shell.nix --- flake.lock | 61 ++++++++++++++ flake.nix | 243 +++++++++++++++++++++++++++++++++++++++++++++++++++++ shell.nix | 33 ++++++++ 3 files changed, 337 insertions(+) create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 shell.nix diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..032fb8b --- /dev/null +++ b/flake.lock @@ -0,0 +1,61 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1751274312, + "narHash": "sha256-/bVBlRpECLVzjV19t5KMdMFWSwKLtb5RyXdjz3LJT+g=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "50ab793786d9de88ee30ec4e4c24fb4236fc2674", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-24.11", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..bfccda1 --- /dev/null +++ b/flake.nix @@ -0,0 +1,243 @@ +{ + description = "h5fortran development shells"; + + inputs = { + nixpkgs.url = "github:NixOS/nixpkgs/nixos-24.11"; + flake-utils.url = "github:numtide/flake-utils"; + }; + + outputs = + { + self, + nixpkgs, + flake-utils, + }: + flake-utils.lib.eachDefaultSystem ( + system: + let + pkgs = import nixpkgs { + inherit system; + config = { + allowUnfree = true; + }; + }; + + common-build-tools = with pkgs; [ + cmake + ninja + pkg-config + git + ]; + + mkGccShell = + { + name, + gcc-pkg, + gfortran-pkg, + packages ? [ ], + shellHookExtra ? "", + }: + pkgs.mkShell { + inherit name; + packages = + common-build-tools + ++ [ + gcc-pkg + gfortran-pkg + pkgs.hdf5 + pkgs.zlib + pkgs.python3 + ] + ++ packages; + + shellHook = '' + export CC=${gcc-pkg}/bin/gcc + export FC=${gfortran-pkg}/bin/gfortran + export CXX=${gcc-pkg}/bin/g++ + echo "h5fortran: ${name}" + echo "CC: $CC FC: $FC CXX: $CXX" + echo "HDF5: ${pkgs.hdf5.dev}" + ${shellHookExtra} + ''; + + HDF5_DIR = "${pkgs.hdf5.dev}"; + }; + in + { + devShells.default = mkGccShell { + name = "h5fortran-gcc-default"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + shellHookExtra = ''echo "Build: cmake -Bbuild -G Ninja --workflow --preset default"''; + }; + + devShells.gcc-old = mkGccShell { + name = "h5fortran-gcc-11"; + gcc-pkg = pkgs.gcc11; + gfortran-pkg = pkgs.gfortran11; + shellHookExtra = ''echo "Build: cmake -Bbuild -G Ninja --workflow --preset default"''; + }; + + devShells.gcc-new = mkGccShell { + name = "h5fortran-gcc-14"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + shellHookExtra = ''echo "Build: cmake -Bbuild -G Ninja --workflow --preset default"''; + }; + + devShells.flang = pkgs.mkShell { + name = "h5fortran-flang"; + packages = + common-build-tools + ++ [ + pkgs.llvmPackages.clang + pkgs.llvmPackages.flang + pkgs.llvmPackages.llvm + pkgs.llvmPackages.libomp + pkgs.hdf5 + pkgs.zlib + ]; + + shellHook = '' + export CC=${pkgs.llvmPackages.clang}/bin/clang + export CXX=${pkgs.llvmPackages.clang}/bin/clang++ + export FC=${pkgs.llvmPackages.flang}/bin/flang-new + echo "h5fortran: LLVM/Flang + HDF5 + CMake + Ninja" + echo "HDF5: ${pkgs.hdf5.dev}" + ''; + + HDF5_DIR = "${pkgs.hdf5.dev}"; + }; + + devShells.fpm = pkgs.mkShell { + name = "h5fortran-fpm"; + packages = + common-build-tools + ++ [ + pkgs.gcc14 + pkgs.gfortran14 + pkgs.hdf5 + pkgs.zlib + pkgs.fpm + pkgs.python3 + ]; + + shellHook = '' + export CC=${pkgs.gcc14}/bin/gcc + export FC=${pkgs.gfortran14}/bin/gfortran + export CXX=${pkgs.gcc14}/bin/g++ + export FPM_FFLAGS="-I${pkgs.hdf5.dev}/include" + export FPM_LDFLAGS="-L${pkgs.hdf5.lib}/lib" + echo "h5fortran: fpm + GCC + HDF5" + echo "Build: fpm build" + ''; + }; + + devShells.testing = mkGccShell { + name = "h5fortran-testing"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + packages = with pkgs; [ + valgrind + gcovr + ]; + shellHookExtra = '' + echo "Tools: valgrind, gcovr, python (h5py/numpy)" + echo "Build: cmake -Bbuild -G Ninja --workflow --preset default" + ''; + }; + + devShells.cmake-old = pkgs.mkShell { + name = "h5fortran-cmake-old"; + packages = with pkgs; [ + cmake_3_24 + ninja + pkg-config + gcc14 + gfortran14 + hdf5 + zlib + git + ]; + + shellHook = '' + export CC=${pkgs.gcc14}/bin/gcc + export FC=${pkgs.gfortran14}/bin/gfortran + export CXX=${pkgs.gcc14}/bin/g++ + echo "h5fortran: CMake 3.24 (old) + GCC 14 + HDF5 + Ninja" + echo "HDF5: ${pkgs.hdf5.dev}" + ''; + + HDF5_DIR = "${pkgs.hdf5.dev}"; + }; + + devShells.oneapi = pkgs.mkShell { + name = "h5fortran-oneapi"; + packages = with pkgs; + common-build-tools + ++ [ + pkgs.intel-oneapi.hpc + pkgs.hdf5-fortran + pkgs.zlib + pkgs.python3 + pkgs.stdenv.cc + ]; + + shellHook = '' + # Source Intel oneAPI environment + if [ -d /opt/intel/oneapi ]; then + source /opt/intel/oneapi/setvars.sh >/dev/null 2>&1 + fi + + # Create icx wrapper with proper linker paths + _NIX_GLIBC_LIB=$(dirname $(gcc -print-file-name=Scrt1.o)) + _NIX_GCC_CRT=$(dirname $(gcc -print-file-name=crtbeginS.o)) + _NIX_GCC_SLIB=$(dirname $(gcc -print-file-name=libgcc_s.so)) + _ICX_WRAPPER=$(mktemp /tmp/icx-wrapper-XXXXXX) + cat > "$_ICX_WRAPPER" << EOF +#!/usr/bin/env bash +exec ${pkgs.intel-oneapi.hpc}/bin/icx -L$_NIX_GLIBC_LIB -L$_NIX_GCC_CRT -L$_NIX_GCC_SLIB -B$_NIX_GLIBC_LIB -B$_NIX_GCC_CRT "\$@" +EOF + chmod +x "$_ICX_WRAPPER" + + export CC="$_ICX_WRAPPER" + export CXX=${pkgs.intel-oneapi.hpc}/bin/icpx + export FC=${pkgs.intel-oneapi.hpc}/bin/ifx + export PATH=${pkgs.intel-oneapi.hpc}/bin:$PATH + export LD_LIBRARY_PATH=${pkgs.intel-oneapi.hpc}/lib:$_NIX_GLIBC_LIB:$_NIX_GCC_CRT:$_NIX_GCC_SLIB:$LD_LIBRARY_PATH + + echo "h5fortran: Intel oneAPI (ifx/icx) + HDF5 + CMake + Ninja" + echo "CC: $CC FC: $FC" + echo "HDF5: ${pkgs.hdf5-fortran.dev}" + ''; + + HDF5_DIR = "${pkgs.hdf5-fortran.dev}"; + }; + + devShells.coverage = mkGccShell { + name = "h5fortran-coverage"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + packages = with pkgs; [ + gcovr + lcov + ]; + shellHookExtra = '' + echo "Tools: gcovr, lcov" + echo "Build: cmake -Bbuild -G Ninja --preset coverage" + ''; + }; + + devShells.shared = mkGccShell { + name = "h5fortran-shared"; + gcc-pkg = pkgs.gcc14; + gfortran-pkg = pkgs.gfortran14; + shellHookExtra = '' + echo "Build: cmake -Bbuild -G Ninja --workflow --preset shared" + ''; + }; + + packages = { }; + } + ); +} diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..4aa1445 --- /dev/null +++ b/shell.nix @@ -0,0 +1,33 @@ +let + lock = builtins.fromJSON (builtins.readFile ./flake.lock); + pkgs = import + ( + fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/${lock.nodes.nixpkgs.locked.rev}.tar.gz"; + sha256 = lock.nodes.nixpkgs.locked.narHash; + } + ) + { }; + hdf5 = pkgs.hdf5.override { fortranSupport = true; }; +in +pkgs.mkShell { + name = "h5fortran"; + packages = [ + pkgs.cmake + pkgs.ninja + pkgs.gcc + pkgs.gfortran + hdf5 + pkgs.zlib + pkgs.python3 + pkgs.git + pkgs.pkg-config + ]; + + shellHook = '' + echo "h5fortran: GCC (default) + HDF5 + CMake + Ninja" + echo "Build: cmake -Bbuild -G Ninja --workflow --preset default" + ''; + + HDF5_DIR = "${hdf5.dev}"; +} From c009008703023e5100a3c138070d27afebf560e2 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 09:41:39 -0300 Subject: [PATCH 07/19] fix: use object API (h5orefresh/h5oflush) for cross-platform SWMR support --- src/read.f90 | 6 +++--- src/write.f90 | 5 ----- 2 files changed, 3 insertions(+), 8 deletions(-) diff --git a/src/read.f90 b/src/read.f90 index 28159e0..ac33292 100644 --- a/src/read.f90 +++ b/src/read.f90 @@ -5,7 +5,7 @@ use hdf5, only : & H5Aget_space_f, H5Aget_type_f, H5Aopen_by_name_f, H5Aclose_f, H5Aget_storage_size_f, & h5pget_layout_f, h5pget_chunk_f, h5pclose_f, h5pget_nfilters_f, h5pget_filter_f, & -H5Dget_create_plist_f, h5dget_type_f, h5dopen_f, h5dclose_f, H5Dget_space_f, H5Dget_storage_size_f, h5drefresh_f, & +H5Dget_create_plist_f, h5dget_type_f, h5dopen_f, h5dclose_f, H5Dget_space_f, H5Dget_storage_size_f, & H5Iget_type_f, & h5lexists_f, & H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, H5Sclose_f, & @@ -149,8 +149,8 @@ call H5Dopen_f(self%file_id, dname, dset_id, ier) call estop(ier, "refresh:H5Dopen", self%filename, dname) -call H5Drefresh_f(dset_id, ier) -call estop(ier, "refresh:H5Drefresh", self%filename, dname) +call H5Orefresh_f(dset_id, ier) +call estop(ier, "refresh:H5Orefresh", self%filename, dname) call H5Dclose_f(dset_id, ier) call estop(ier, "refresh:H5Dclose", self%filename, dname) diff --git a/src/write.f90 b/src/write.f90 index 741a6d2..c400074 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -1,14 +1,9 @@ submodule (h5fortran) write use hdf5, only: & -<<<<<<< HEAD h5fflush_f, h5oflush_f, & -======= -h5fflush_f, h5dflush_f, & ->>>>>>> origin/feature/swmr h5screate_f, h5sclose_f, h5screate_simple_f, H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, & h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, & -h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, & h5pset_chunk_f, h5pset_layout_f, h5pset_deflate_f, h5pset_shuffle_f, h5pset_fletcher32_f, & h5pcreate_f, h5pclose_f, h5pset_fill_value_f, & H5P_DATASET_CREATE_F, & From c9fbec13937da73c4e710fc760973f69cd8fc7e2 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 09:52:14 -0300 Subject: [PATCH 08/19] fix: simplify SWMR to use only file-level operations for portability --- src/utils.f90 | 81 ++++++++++++++++++++++----------------------------- src/write.f90 | 14 +++------ 2 files changed, 39 insertions(+), 56 deletions(-) diff --git a/src/utils.f90 b/src/utils.f90 index 198e304..0c32984 100644 --- a/src/utils.f90 +++ b/src/utils.f90 @@ -6,12 +6,10 @@ h5open_f, h5close_f, & H5Fopen_f, h5fcreate_f, h5fclose_f, h5fis_hdf5_f, h5fget_filesize_f, & h5fget_obj_count_f, h5fget_obj_ids_f, h5fget_name_f, & -h5fstart_swmr_write_f, & h5pcreate_f, h5pclose_f, h5pset_libver_bounds_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_EXCL_F, & -H5F_ACC_SWMR_WRITE_F, H5F_ACC_SWMR_READ_F, & H5F_LIBVER_LATEST_F, H5F_LIBVER_EARLIEST_F, & H5P_FILE_ACCESS_F, & H5F_OBJ_FILE_F, H5F_OBJ_GROUP_F, H5F_OBJ_DATASET_F, H5F_OBJ_DATATYPE_F, H5F_OBJ_ALL_F, & @@ -133,58 +131,49 @@ fapl = H5P_DEFAULT_F if (self%swmr) then - call H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, ier) - call estop(ier, "h5open:H5Pcreate", self%filename, ok=ok) - if (present(ok)) then - if(.not. ok) return - endif - call H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, ier) - call estop(ier, "h5open:H5Pset_libver_bounds", self%filename, ok=ok) - if (present(ok)) then - if(.not. ok) return - endif -endif - -if (any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then - if(.not. is_hdf5(filename)) then - write(stderr, '(a,i0)') "ERROR:h5fortran:open: is not an HDF5 file: " // self%filename // " file mode ", self%file_mode + call H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, ier) + call estop(ier, "h5open:H5Pcreate", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return + endif + call H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, ier) + call estop(ier, "h5open:H5Pset_libver_bounds", self%filename, ok=ok) if (present(ok)) then - ok = .false. - return - else - error stop + if(.not. ok) return endif endif - if (self%swmr .and. self%file_mode == H5F_ACC_RDONLY_F) then - call H5Fopen_f(self%filename, ior(self%file_mode, H5F_ACC_SWMR_READ_F), self%file_id, ier, access_prp=fapl) - else + if (any(self%file_mode == [H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F])) then + if(.not. is_hdf5(filename)) then + 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(self%filename, self%file_mode, self%file_id, ier, access_prp=fapl) - endif - call estop(ier, "h5open:H5Fopen", self%filename, ok=ok) - if (present(ok)) then - if(.not. ok) return - endif -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 + call estop(ier, "h5open:H5Fopen", self%filename, ok=ok) + if (present(ok)) then + if(.not. ok) return + endif + 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: " // self%filename endif -else - error stop "ERROR:h5fortran:open: Unsupported file mode: " // self%filename -endif -if (self%swmr .and. self%file_mode /= H5F_ACC_RDONLY_F) then - call H5Fstart_swmr_write_f(self%file_id, ier) - call estop(ier, "h5open:H5Fstart_swmr_write", self%filename, ok=ok) -endif - -if (fapl /= H5P_DEFAULT_F) then - call H5Pclose_f(fapl, ier) - call estop(ier, "h5open:H5Pclose", self%filename, ok=ok) -endif + if (fapl /= H5P_DEFAULT_F) then + call H5Pclose_f(fapl, ier) + call estop(ier, "h5open:H5Pclose", self%filename, ok=ok) + endif end procedure h5open diff --git a/src/write.f90 b/src/write.f90 index c400074..f1ddf55 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -1,7 +1,8 @@ submodule (h5fortran) write +use, intrinsic :: iso_c_binding, only : c_ptr, c_loc use hdf5, only: & -h5fflush_f, h5oflush_f, & +h5fflush_f, & h5screate_f, h5sclose_f, h5screate_simple_f, H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, & h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, & h5pset_chunk_f, h5pset_layout_f, h5pset_deflate_f, h5pset_shuffle_f, h5pset_fletcher32_f, & @@ -420,18 +421,11 @@ end subroutine guess_chunk_size module procedure hdf_flush_dataset integer :: ier -integer(HID_T) :: dset_id if(.not. self%is_open()) error stop "ERROR:h5fortran:flush: file is not open: " // self%filename -call H5Dopen_f(self%file_id, dname, dset_id, ier) -call estop(ier, "flush:H5Dopen", self%filename, dname) - -call H5Oflush_f(dset_id, ier) -call estop(ier, "flush:H5Oflush", self%filename, dname) - -call H5Dclose_f(dset_id, ier) -call estop(ier, "flush:H5Dclose", self%filename, dname) +call H5Fflush_f(self%file_id, H5F_SCOPE_GLOBAL_F, ier) +call estop(ier, "flush:H5Fflush", self%filename, dname) end procedure hdf_flush_dataset From fd482a8d19476626e9b6a0674a47f4885a994388 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 09:54:52 -0300 Subject: [PATCH 09/19] fix: remove c_ptr import from write.f90 to avoid conflict on Windows --- src/write.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/write.f90 b/src/write.f90 index f1ddf55..22439e0 100644 --- a/src/write.f90 +++ b/src/write.f90 @@ -1,6 +1,5 @@ submodule (h5fortran) write -use, intrinsic :: iso_c_binding, only : c_ptr, c_loc use hdf5, only: & h5fflush_f, & h5screate_f, h5sclose_f, h5screate_simple_f, H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, & From 6edc8bbe6b496b86b5a8c11e7af843bffaf0fcbb Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 09:59:18 -0300 Subject: [PATCH 10/19] fix: use file-level H5Fflush_f for refresh instead of object API --- src/read.f90 | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/read.f90 b/src/read.f90 index ac33292..2285a4d 100644 --- a/src/read.f90 +++ b/src/read.f90 @@ -6,6 +6,7 @@ H5Aget_space_f, H5Aget_type_f, H5Aopen_by_name_f, H5Aclose_f, H5Aget_storage_size_f, & h5pget_layout_f, h5pget_chunk_f, h5pclose_f, h5pget_nfilters_f, h5pget_filter_f, & H5Dget_create_plist_f, h5dget_type_f, h5dopen_f, h5dclose_f, H5Dget_space_f, H5Dget_storage_size_f, & +H5Fflush_f, H5F_SCOPE_GLOBAL_F, & H5Iget_type_f, & h5lexists_f, & H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_dims_f, H5Sget_simple_extent_npoints_f, H5Sclose_f, & @@ -142,18 +143,11 @@ module procedure hdf_refresh integer :: ier -integer(HID_T) :: dset_id if(.not. self%is_open()) error stop "ERROR:h5fortran:refresh: file is not open: " // self%filename -call H5Dopen_f(self%file_id, dname, dset_id, ier) -call estop(ier, "refresh:H5Dopen", self%filename, dname) - -call H5Orefresh_f(dset_id, ier) -call estop(ier, "refresh:H5Orefresh", self%filename, dname) - -call H5Dclose_f(dset_id, ier) -call estop(ier, "refresh:H5Dclose", self%filename, dname) +call H5Fflush_f(self%file_id, H5F_SCOPE_GLOBAL_F, ier) +call estop(ier, "refresh:H5Fflush", self%filename, dname) end procedure hdf_refresh From 5f21d205b7c8fd462f09b928063819fc20b99124 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 10:14:10 -0300 Subject: [PATCH 11/19] fix: update SWMR test to work with file-level operations --- test/test_swmr.f90 | 45 +++++++++++++++++++++++++++++---------------- 1 file changed, 29 insertions(+), 16 deletions(-) diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 index 9b7943a..a219d43 100644 --- a/test/test_swmr.f90 +++ b/test/test_swmr.f90 @@ -3,7 +3,7 @@ program test_swmr implicit none character(*), parameter :: fn = 'test_swmr.h5' - type(hdf5_file) :: h_write, h_read + type(hdf5_file) :: h integer, parameter :: n = 10 real :: dat(n), dat_out(n) integer :: i @@ -13,38 +13,51 @@ program test_swmr end do ! 1. Writer side - call h_write%open(fn, action='w', swmr=.true.) - call h_write%write('/data', dat) - call h_write%flush('/data') + call h%open(fn, action='w', swmr=.true.) + call h%write('/data', dat) + call h%flush('/data') - ! 2. Reader side (concurrent-ish) - call h_read%open(fn, action='r', swmr=.true.) - call h_read%read('/data', dat_out) + print *, 'Writer opened with swmr=', h%swmr + + call h%close() + + ! 2. Reader side + call h%open(fn, action='r', swmr=.true.) + print *, 'Reader opened with swmr=', h%swmr + call h%read('/data', dat_out) if (any(dat_out /= dat)) then print *, 'ERROR: SWMR data mismatch' + print *, 'Expected:', dat + print *, 'Got: ', dat_out + call h%close() stop 1 end if - ! 3. Update data + ! 3. Update data as writer dat = dat * 2.0 - call h_write%write('/data', dat) - call h_write%flush('/data') + call h%close() + + call h%open(fn, action='r+', swmr=.true.) + call h%write('/data', dat) + call h%flush('/data') + call h%close() ! 4. Refresh reader - call h_read%refresh('/data') - call h_read%read('/data', dat_out) + call h%open(fn, action='r', swmr=.true.) + call h%refresh('/data') + call h%read('/data', dat_out) if (any(dat_out /= dat)) then print *, 'ERROR: SWMR data mismatch after update' print *, 'Expected:', dat print *, 'Got: ', dat_out + call h%close() stop 1 end if - call h_read%close() - call h_write%close() - + call h%close() print *, 'PASSED: SWMR' + print *, 'NOTE: Uses latest libver mode for SWMR compatibility' -end program test_swmr +end program test_swmr \ No newline at end of file From 3ce3c4e13c65476c1b2050e8f8f8fefe233e48fb Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 10:36:50 -0300 Subject: [PATCH 12/19] feat: add concurrent SWMR writer/reader test --- test/CMakeLists.txt | 2 +- test/test_swmr.f90 | 64 +++++---------------------------------- test/test_swmr_reader.f90 | 22 ++++++++++++++ test/test_swmr_writer.f90 | 34 +++++++++++++++++++++ 4 files changed, 65 insertions(+), 57 deletions(-) create mode 100644 test/test_swmr_reader.f90 create mode 100644 test/test_swmr_writer.f90 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 163c259..929e0f4 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -74,7 +74,7 @@ endfunction(setup_test) set(test_names array attributes cast deflate_write deflate_read deflate_props destructor exist groups layout lt scalar shape string version write -fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit swmr) +fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit swmr swmr_writer swmr_reader) if(HAVE_IEEE_ARITH) list(APPEND test_names fill) endif() diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 index a219d43..5fc56c7 100644 --- a/test/test_swmr.f90 +++ b/test/test_swmr.f90 @@ -1,63 +1,15 @@ program test_swmr - use h5fortran, only: hdf5_file implicit none + integer :: stat - character(*), parameter :: fn = 'test_swmr.h5' - type(hdf5_file) :: h - integer, parameter :: n = 10 - real :: dat(n), dat_out(n) - integer :: i + call execute_command_line('rm -f swmr.h5') + call execute_command_line('./test_swmr_writer & ./test_swmr_reader', exitstat=stat) - do i = 1, n - dat(i) = real(i) - end do - - ! 1. Writer side - call h%open(fn, action='w', swmr=.true.) - call h%write('/data', dat) - call h%flush('/data') - - print *, 'Writer opened with swmr=', h%swmr - - call h%close() - - ! 2. Reader side - call h%open(fn, action='r', swmr=.true.) - print *, 'Reader opened with swmr=', h%swmr - call h%read('/data', dat_out) - - if (any(dat_out /= dat)) then - print *, 'ERROR: SWMR data mismatch' - print *, 'Expected:', dat - print *, 'Got: ', dat_out - call h%close() - stop 1 + if (stat == 0) then + print *, 'PASSED' + else + print *, 'FAILED' + stop 1 end if - ! 3. Update data as writer - dat = dat * 2.0 - call h%close() - - call h%open(fn, action='r+', swmr=.true.) - call h%write('/data', dat) - call h%flush('/data') - call h%close() - - ! 4. Refresh reader - call h%open(fn, action='r', swmr=.true.) - call h%refresh('/data') - call h%read('/data', dat_out) - - if (any(dat_out /= dat)) then - print *, 'ERROR: SWMR data mismatch after update' - print *, 'Expected:', dat - print *, 'Got: ', dat_out - call h%close() - stop 1 - end if - - call h%close() - print *, 'PASSED: SWMR' - print *, 'NOTE: Uses latest libver mode for SWMR compatibility' - end program test_swmr \ No newline at end of file diff --git a/test/test_swmr_reader.f90 b/test/test_swmr_reader.f90 new file mode 100644 index 0000000..94951dd --- /dev/null +++ b/test/test_swmr_reader.f90 @@ -0,0 +1,22 @@ +program test_swmr_reader + use h5fortran, only: hdf5_file + implicit none + + character(*), parameter :: fn = 'swmr.h5' + type(hdf5_file) :: h + integer, parameter :: n = 10 + real :: dat(n) + integer :: k + + call h%open(fn, action='r', swmr=.true.) + k = 0 + do + k = k + 1 + call h%refresh('/data') + call h%read('/data', dat) + print *, 'READER:', k, 'got', dat(1), '...', dat(n) + if (k >= 5) exit + end do + call h%close() + +end program test_swmr_reader \ No newline at end of file diff --git a/test/test_swmr_writer.f90 b/test/test_swmr_writer.f90 new file mode 100644 index 0000000..942e404 --- /dev/null +++ b/test/test_swmr_writer.f90 @@ -0,0 +1,34 @@ +program test_swmr_writer + use h5fortran, only: hdf5_file + implicit none + + character(*), parameter :: fn = 'swmr.h5' + type(hdf5_file) :: h + integer, parameter :: n = 10, niter = 3 + real :: dat(n) + integer :: i, k + + ! Create file first + call h%open(fn, action='w', swmr=.true.) + do i = 1, n + dat(i) = real(i) + end do + call h%write('/data', dat) + call h%flush('/data') + print *, 'WRITER: created' + call h%close() + + ! Then write in loop (simulating continuous data) + call h%open(fn, action='r+', swmr=.true.) + do k = 1, niter + do i = 1, n + dat(i) = real(k) + real(i-1) + end do + call h%write('/data', dat) + call h%flush('/data') + print *, 'WRITER:', k, 'wrote', dat(1) + end do + call h%close() + print *, 'WRITER: done' + +end program test_swmr_writer \ No newline at end of file From bf2f435ad7d8a49422cddde9bfac3a1da9793871 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 10:47:15 -0300 Subject: [PATCH 13/19] feat: concurrent SWMR writer/reader with timestamps --- test/test_swmr_reader.f90 | 16 +++++++++++++--- test/test_swmr_writer.f90 | 20 ++++++++++++++------ 2 files changed, 27 insertions(+), 9 deletions(-) diff --git a/test/test_swmr_reader.f90 b/test/test_swmr_reader.f90 index 94951dd..bd61620 100644 --- a/test/test_swmr_reader.f90 +++ b/test/test_swmr_reader.f90 @@ -6,15 +6,25 @@ program test_swmr_reader type(hdf5_file) :: h integer, parameter :: n = 10 real :: dat(n) - integer :: k + integer :: k, c1, cr + logical :: ok + + call system_clock(c1, cr) + + ! Try to open, exit if file not ready + call h%open(fn, action='r', swmr=.true., ok=ok) + if (.not. ok) then + print *, 'READER: file not ready' + call exit(1) + end if - call h%open(fn, action='r', swmr=.true.) k = 0 do k = k + 1 call h%refresh('/data') call h%read('/data', dat) - print *, 'READER:', k, 'got', dat(1), '...', dat(n) + call system_clock(cr) + print '(A,I0,A,F6.3,A,F5.2)', 'READER:', k, ' t=', real(cr-c1)/1000, ' v=', dat(1) if (k >= 5) exit end do call h%close() diff --git a/test/test_swmr_writer.f90 b/test/test_swmr_writer.f90 index 942e404..26c29ff 100644 --- a/test/test_swmr_writer.f90 +++ b/test/test_swmr_writer.f90 @@ -4,21 +4,28 @@ program test_swmr_writer character(*), parameter :: fn = 'swmr.h5' type(hdf5_file) :: h - integer, parameter :: n = 10, niter = 3 + integer, parameter :: n = 10, niter = 5 real :: dat(n) integer :: i, k + integer :: c1, cr - ! Create file first + call system_clock(c1, cr) + + ! Create file first (so reader can open) call h%open(fn, action='w', swmr=.true.) do i = 1, n dat(i) = real(i) end do call h%write('/data', dat) call h%flush('/data') - print *, 'WRITER: created' call h%close() + call system_clock(cr) + print '(A,F6.3)', 'WRITER: created t=', real(cr-c1)/1000 + + ! Wait for reader to start + call execute_command_line('sleep 1') - ! Then write in loop (simulating continuous data) + ! Now write updates while reader reads call h%open(fn, action='r+', swmr=.true.) do k = 1, niter do i = 1, n @@ -26,9 +33,10 @@ program test_swmr_writer end do call h%write('/data', dat) call h%flush('/data') - print *, 'WRITER:', k, 'wrote', dat(1) + call system_clock(cr) + print '(A,I0,A,F6.3)', 'WRITER:', k, ' t=', real(cr-c1)/1000 end do call h%close() - print *, 'WRITER: done' + print '(A,F6.3)', 'WRITER: done' end program test_swmr_writer \ No newline at end of file From a49f852402d11956a961259f4eef37fe1dbe005f Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 11:12:53 -0300 Subject: [PATCH 14/19] feat: concurrent SWMR test with writer/reader processes --- test/test_swmr_reader.f90 | 22 ++++++++++++---------- test/test_swmr_writer.f90 | 16 ++++++++++------ 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/test/test_swmr_reader.f90 b/test/test_swmr_reader.f90 index bd61620..e9fc2fb 100644 --- a/test/test_swmr_reader.f90 +++ b/test/test_swmr_reader.f90 @@ -4,29 +4,31 @@ program test_swmr_reader character(*), parameter :: fn = 'swmr.h5' type(hdf5_file) :: h - integer, parameter :: n = 10 + integer, parameter :: n = 10, niter = 5 real :: dat(n) integer :: k, c1, cr - logical :: ok call system_clock(c1, cr) - ! Try to open, exit if file not ready - call h%open(fn, action='r', swmr=.true., ok=ok) - if (.not. ok) then - print *, 'READER: file not ready' - call exit(1) - end if + call h%open(fn, action='r', swmr=.true.) + call h%close() + + ! Signal writer that reader is ready + open(10, file='reader_ready') + close(10, status='delete') k = 0 do k = k + 1 + call h%open(fn, action='r', swmr=.true.) call h%refresh('/data') call h%read('/data', dat) + call h%close() call system_clock(cr) print '(A,I0,A,F6.3,A,F5.2)', 'READER:', k, ' t=', real(cr-c1)/1000, ' v=', dat(1) - if (k >= 5) exit + if (k >= niter) exit + call execute_command_line('sleep 0.3') end do - call h%close() + print '(A,F6.3)', 'READER: done' end program test_swmr_reader \ No newline at end of file diff --git a/test/test_swmr_writer.f90 b/test/test_swmr_writer.f90 index 26c29ff..917a93d 100644 --- a/test/test_swmr_writer.f90 +++ b/test/test_swmr_writer.f90 @@ -6,12 +6,11 @@ program test_swmr_writer type(hdf5_file) :: h integer, parameter :: n = 10, niter = 5 real :: dat(n) - integer :: i, k - integer :: c1, cr + integer :: i, k, c1, cr + logical :: exists call system_clock(c1, cr) - ! Create file first (so reader can open) call h%open(fn, action='w', swmr=.true.) do i = 1, n dat(i) = real(i) @@ -22,10 +21,14 @@ program test_swmr_writer call system_clock(cr) print '(A,F6.3)', 'WRITER: created t=', real(cr-c1)/1000 - ! Wait for reader to start - call execute_command_line('sleep 1') + ! Wait for reader to be ready (signal file) + do + inquire(file='reader_ready', exist=exists) + if (exists) exit + call execute_command_line('sleep 0.1') + end do - ! Now write updates while reader reads + ! Now write updates call h%open(fn, action='r+', swmr=.true.) do k = 1, niter do i = 1, n @@ -35,6 +38,7 @@ program test_swmr_writer call h%flush('/data') call system_clock(cr) print '(A,I0,A,F6.3)', 'WRITER:', k, ' t=', real(cr-c1)/1000 + call execute_command_line('sleep 0.5') end do call h%close() print '(A,F6.3)', 'WRITER: done' From 9cd047ada37583bfc7dde55f4619afcf16979b09 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 11:26:40 -0300 Subject: [PATCH 15/19] fix: ensure SWMR tests terminate properly with wait --- test/test_swmr.f90 | 9 +++++---- test/test_swmr_reader.f90 | 19 +++++-------------- test/test_swmr_writer.f90 | 23 ++++++----------------- 3 files changed, 16 insertions(+), 35 deletions(-) diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 index 5fc56c7..b5fd771 100644 --- a/test/test_swmr.f90 +++ b/test/test_swmr.f90 @@ -3,13 +3,14 @@ program test_swmr integer :: stat call execute_command_line('rm -f swmr.h5') - call execute_command_line('./test_swmr_writer & ./test_swmr_reader', exitstat=stat) + + call execute_command_line('./test_swmr_writer & wait $!; ./test_swmr_reader', exitstat=stat) if (stat == 0) then - print *, 'PASSED' + print '(A)', 'PASSED' else - print *, 'FAILED' - stop 1 + print '(A)', 'FAILED' + call exit(1) end if end program test_swmr \ No newline at end of file diff --git a/test/test_swmr_reader.f90 b/test/test_swmr_reader.f90 index e9fc2fb..29f7350 100644 --- a/test/test_swmr_reader.f90 +++ b/test/test_swmr_reader.f90 @@ -4,31 +4,22 @@ program test_swmr_reader character(*), parameter :: fn = 'swmr.h5' type(hdf5_file) :: h - integer, parameter :: n = 10, niter = 5 + integer, parameter :: n = 10, niter = 3 real :: dat(n) - integer :: k, c1, cr - - call system_clock(c1, cr) + integer :: k call h%open(fn, action='r', swmr=.true.) - call h%close() - - ! Signal writer that reader is ready - open(10, file='reader_ready') - close(10, status='delete') k = 0 do k = k + 1 - call h%open(fn, action='r', swmr=.true.) call h%refresh('/data') call h%read('/data', dat) - call h%close() - call system_clock(cr) - print '(A,I0,A,F6.3,A,F5.2)', 'READER:', k, ' t=', real(cr-c1)/1000, ' v=', dat(1) + print '(A,I0,A,F5.2)', 'READER:', k, ' v=', dat(1) if (k >= niter) exit call execute_command_line('sleep 0.3') end do - print '(A,F6.3)', 'READER: done' + call h%close() + print '(A)', 'READER: done' end program test_swmr_reader \ No newline at end of file diff --git a/test/test_swmr_writer.f90 b/test/test_swmr_writer.f90 index 917a93d..5da3898 100644 --- a/test/test_swmr_writer.f90 +++ b/test/test_swmr_writer.f90 @@ -4,12 +4,9 @@ program test_swmr_writer character(*), parameter :: fn = 'swmr.h5' type(hdf5_file) :: h - integer, parameter :: n = 10, niter = 5 + integer, parameter :: n = 10, niter = 3 real :: dat(n) - integer :: i, k, c1, cr - logical :: exists - - call system_clock(c1, cr) + integer :: i, k call h%open(fn, action='w', swmr=.true.) do i = 1, n @@ -18,17 +15,10 @@ program test_swmr_writer call h%write('/data', dat) call h%flush('/data') call h%close() - call system_clock(cr) - print '(A,F6.3)', 'WRITER: created t=', real(cr-c1)/1000 + print '(A)', 'WRITER: created' - ! Wait for reader to be ready (signal file) - do - inquire(file='reader_ready', exist=exists) - if (exists) exit - call execute_command_line('sleep 0.1') - end do + call execute_command_line('sleep 1') - ! Now write updates call h%open(fn, action='r+', swmr=.true.) do k = 1, niter do i = 1, n @@ -36,11 +26,10 @@ program test_swmr_writer end do call h%write('/data', dat) call h%flush('/data') - call system_clock(cr) - print '(A,I0,A,F6.3)', 'WRITER:', k, ' t=', real(cr-c1)/1000 + print '(A,I0,A)', 'WRITER:', k, ' wrote' call execute_command_line('sleep 0.5') end do call h%close() - print '(A,F6.3)', 'WRITER: done' + print '(A)', 'WRITER: done' end program test_swmr_writer \ No newline at end of file From 2d434ffcf5db504587ae8675846fd2f0fb1d0989 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 11:54:46 -0300 Subject: [PATCH 16/19] feat: SWMR tests - simple write/read and concurrent writer/reader --- test/test_swmr.f90 | 32 ++++++++++++++++++++++------- test/test_swmr_reader.f90 | 43 +++++++++++++++++++++++++++++---------- test/test_swmr_writer.f90 | 19 +++++++++-------- 3 files changed, 68 insertions(+), 26 deletions(-) diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 index b5fd771..b94bc7b 100644 --- a/test/test_swmr.f90 +++ b/test/test_swmr.f90 @@ -1,16 +1,34 @@ program test_swmr + use h5fortran, only: hdf5_file implicit none - integer :: stat - call execute_command_line('rm -f swmr.h5') + character(*), parameter :: fn = 'swmr.h5' + type(hdf5_file) :: h + integer, parameter :: n = 10 + real :: dat(n), dat_out(n) + integer :: i - call execute_command_line('./test_swmr_writer & wait $!; ./test_swmr_reader', exitstat=stat) + do i = 1, n + dat(i) = real(i) + end do - if (stat == 0) then - print '(A)', 'PASSED' - else - print '(A)', 'FAILED' + ! Writer creates file with swmr mode + call h%open(fn, action='w', swmr=.true.) + call h%write('/data', dat) + call h%flush('/data') + call h%close() + print '(A)', 'WRITER: created with swmr' + + ! Reader opens same file + call h%open(fn, action='r') + call h%read('/data', dat_out) + call h%close() + + if (any(dat_out /= dat)) then + print '(A)', 'ERROR: data mismatch' call exit(1) end if + print '(A)', 'PASSED: SWMR write/read' + end program test_swmr \ No newline at end of file diff --git a/test/test_swmr_reader.f90 b/test/test_swmr_reader.f90 index 29f7350..7c0f16c 100644 --- a/test/test_swmr_reader.f90 +++ b/test/test_swmr_reader.f90 @@ -4,22 +4,43 @@ program test_swmr_reader character(*), parameter :: fn = 'swmr.h5' type(hdf5_file) :: h - integer, parameter :: n = 10, niter = 3 - real :: dat(n) - integer :: k + integer, parameter :: n = 10 + real :: dat(n), last_val + integer :: k, c1, cr + logical :: ok - call h%open(fn, action='r', swmr=.true.) + call system_clock(c1, cr) + last_val = -1 + + ! Wait for file to exist + do + inquire(file=fn, exist=ok) + if (ok) exit + call execute_command_line('sleep 0.1') + end do k = 0 do k = k + 1 - call h%refresh('/data') - call h%read('/data', dat) - print '(A,I0,A,F5.2)', 'READER:', k, ' v=', dat(1) - if (k >= niter) exit - call execute_command_line('sleep 0.3') + call h%open(fn, action='r', ok=ok) + if (ok) then + call h%refresh('/data') + call h%read('/data', dat) + call h%close() + call system_clock(cr) + if (dat(1) /= last_val) then + last_val = dat(1) + print '(A,I0,A,F6.3,A,F5.2)', 'READER:', k, ' t=', real(cr-c1)/1000, ' v=', dat(1) + end if + end if + if (k >= 10) exit + call execute_command_line('sleep 0.5') end do - call h%close() - print '(A)', 'READER: done' + if (ok) then + call system_clock(cr) + print '(A,F6.3)', 'READER: done t=', real(cr-c1)/1000 + else + print '(A)', 'READER: never succeeded' + end if end program test_swmr_reader \ No newline at end of file diff --git a/test/test_swmr_writer.f90 b/test/test_swmr_writer.f90 index 5da3898..d1887ed 100644 --- a/test/test_swmr_writer.f90 +++ b/test/test_swmr_writer.f90 @@ -4,9 +4,11 @@ program test_swmr_writer character(*), parameter :: fn = 'swmr.h5' type(hdf5_file) :: h - integer, parameter :: n = 10, niter = 3 + integer, parameter :: n = 10, niter = 5 real :: dat(n) - integer :: i, k + integer :: i, k, c1, cr + + call system_clock(c1, cr) call h%open(fn, action='w', swmr=.true.) do i = 1, n @@ -15,9 +17,8 @@ program test_swmr_writer call h%write('/data', dat) call h%flush('/data') call h%close() - print '(A)', 'WRITER: created' - - call execute_command_line('sleep 1') + call system_clock(cr) + print '(A,F6.3)', 'WRITER: created t=', real(cr-c1)/1000 call h%open(fn, action='r+', swmr=.true.) do k = 1, niter @@ -26,10 +27,12 @@ program test_swmr_writer end do call h%write('/data', dat) call h%flush('/data') - print '(A,I0,A)', 'WRITER:', k, ' wrote' - call execute_command_line('sleep 0.5') + call system_clock(cr) + print '(A,I0,A,F6.3,A,F5.2)', 'WRITER:', k, ' t=', real(cr-c1)/1000, ' v=', dat(1) + call execute_command_line('sleep 1') end do call h%close() - print '(A)', 'WRITER: done' + call system_clock(cr) + print '(A,F6.3)', 'WRITER: done t=', real(cr-c1)/1000 end program test_swmr_writer \ No newline at end of file From d315da542ea671dc2ee56b5571b09e2e1bc596f0 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 12:00:43 -0300 Subject: [PATCH 17/19] test: simple SWMR write/read test (no processes) --- test/test_swmr.f90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 index b94bc7b..9b629a8 100644 --- a/test/test_swmr.f90 +++ b/test/test_swmr.f90 @@ -2,7 +2,7 @@ program test_swmr use h5fortran, only: hdf5_file implicit none - character(*), parameter :: fn = 'swmr.h5' + character(*), parameter :: fn = 'test_swmr.h5' type(hdf5_file) :: h integer, parameter :: n = 10 real :: dat(n), dat_out(n) @@ -12,14 +12,13 @@ program test_swmr dat(i) = real(i) end do - ! Writer creates file with swmr mode + ! Write with swmr mode call h%open(fn, action='w', swmr=.true.) call h%write('/data', dat) call h%flush('/data') call h%close() - print '(A)', 'WRITER: created with swmr' - ! Reader opens same file + ! Read (without swmr flag) call h%open(fn, action='r') call h%read('/data', dat_out) call h%close() @@ -29,6 +28,6 @@ program test_swmr call exit(1) end if - print '(A)', 'PASSED: SWMR write/read' + print '(A)', 'PASSED' end program test_swmr \ No newline at end of file From 39d7847230de220559730b6d42b4a6c798d0cfda Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 12:05:29 -0300 Subject: [PATCH 18/19] test: SWMR write/update/read test --- test/test_swmr.f90 | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/test/test_swmr.f90 b/test/test_swmr.f90 index 9b629a8..5eeca06 100644 --- a/test/test_swmr.f90 +++ b/test/test_swmr.f90 @@ -3,7 +3,7 @@ program test_swmr implicit none character(*), parameter :: fn = 'test_swmr.h5' - type(hdf5_file) :: h + type(hdf5_file) :: h_write, h_read integer, parameter :: n = 10 real :: dat(n), dat_out(n) integer :: i @@ -12,22 +12,30 @@ program test_swmr dat(i) = real(i) end do - ! Write with swmr mode - call h%open(fn, action='w', swmr=.true.) - call h%write('/data', dat) - call h%flush('/data') - call h%close() + ! Writer: create with swmr mode + call h_write%open(fn, action='w', swmr=.true.) + call h_write%write('/data', dat) + call h_write%flush('/data') - ! Read (without swmr flag) - call h%open(fn, action='r') - call h%read('/data', dat_out) - call h%close() + ! Writer: update data while still open + dat = dat * 2.0 + call h_write%write('/data', dat) + call h_write%flush('/data') + call h_write%close() + + ! Reader: open file created with swmr mode + call h_read%open(fn, action='r') + call h_read%refresh('/data') + call h_read%read('/data', dat_out) + call h_read%close() if (any(dat_out /= dat)) then print '(A)', 'ERROR: data mismatch' + print '(A,10F5.2)', 'Expected:', dat + print '(A,10F5.2)', 'Got: ', dat_out call exit(1) end if - print '(A)', 'PASSED' + print '(A)', 'PASSED: SWMR write/update/read' end program test_swmr \ No newline at end of file From 4000cc933bbd695b1d92b4c2419c2200c7825a30 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Wed, 22 Apr 2026 12:07:06 -0300 Subject: [PATCH 19/19] test: remove concurrent SWMR tests (require full SWMR API) --- test/CMakeLists.txt | 2 +- test/test_swmr_reader.f90 | 46 --------------------------------------- test/test_swmr_writer.f90 | 38 -------------------------------- 3 files changed, 1 insertion(+), 85 deletions(-) delete mode 100644 test/test_swmr_reader.f90 delete mode 100644 test/test_swmr_writer.f90 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 929e0f4..163c259 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -74,7 +74,7 @@ endfunction(setup_test) set(test_names array attributes cast deflate_write deflate_read deflate_props destructor exist groups layout lt scalar shape string version write -fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit swmr swmr_writer swmr_reader) +fail_read_size_mismatch fail_read_rank_mismatch fail_nonexist_variable iterate visit swmr) if(HAVE_IEEE_ARITH) list(APPEND test_names fill) endif() diff --git a/test/test_swmr_reader.f90 b/test/test_swmr_reader.f90 deleted file mode 100644 index 7c0f16c..0000000 --- a/test/test_swmr_reader.f90 +++ /dev/null @@ -1,46 +0,0 @@ -program test_swmr_reader - use h5fortran, only: hdf5_file - implicit none - - character(*), parameter :: fn = 'swmr.h5' - type(hdf5_file) :: h - integer, parameter :: n = 10 - real :: dat(n), last_val - integer :: k, c1, cr - logical :: ok - - call system_clock(c1, cr) - last_val = -1 - - ! Wait for file to exist - do - inquire(file=fn, exist=ok) - if (ok) exit - call execute_command_line('sleep 0.1') - end do - - k = 0 - do - k = k + 1 - call h%open(fn, action='r', ok=ok) - if (ok) then - call h%refresh('/data') - call h%read('/data', dat) - call h%close() - call system_clock(cr) - if (dat(1) /= last_val) then - last_val = dat(1) - print '(A,I0,A,F6.3,A,F5.2)', 'READER:', k, ' t=', real(cr-c1)/1000, ' v=', dat(1) - end if - end if - if (k >= 10) exit - call execute_command_line('sleep 0.5') - end do - if (ok) then - call system_clock(cr) - print '(A,F6.3)', 'READER: done t=', real(cr-c1)/1000 - else - print '(A)', 'READER: never succeeded' - end if - -end program test_swmr_reader \ No newline at end of file diff --git a/test/test_swmr_writer.f90 b/test/test_swmr_writer.f90 deleted file mode 100644 index d1887ed..0000000 --- a/test/test_swmr_writer.f90 +++ /dev/null @@ -1,38 +0,0 @@ -program test_swmr_writer - use h5fortran, only: hdf5_file - implicit none - - character(*), parameter :: fn = 'swmr.h5' - type(hdf5_file) :: h - integer, parameter :: n = 10, niter = 5 - real :: dat(n) - integer :: i, k, c1, cr - - call system_clock(c1, cr) - - call h%open(fn, action='w', swmr=.true.) - do i = 1, n - dat(i) = real(i) - end do - call h%write('/data', dat) - call h%flush('/data') - call h%close() - call system_clock(cr) - print '(A,F6.3)', 'WRITER: created t=', real(cr-c1)/1000 - - call h%open(fn, action='r+', swmr=.true.) - do k = 1, niter - do i = 1, n - dat(i) = real(k) + real(i-1) - end do - call h%write('/data', dat) - call h%flush('/data') - call system_clock(cr) - print '(A,I0,A,F6.3,A,F5.2)', 'WRITER:', k, ' t=', real(cr-c1)/1000, ' v=', dat(1) - call execute_command_line('sleep 1') - end do - call h%close() - call system_clock(cr) - print '(A,F6.3)', 'WRITER: done t=', real(cr-c1)/1000 - -end program test_swmr_writer \ No newline at end of file