Add Fortran SWMR wrappers (#5985)

* Add Fortran wrappers for H5Fstart_swmr_write, H5Dflush, and H5P{set,get}_append_flush
* corrected C doxygen docs for H5Pget_append_flush, clarified Fortran
This commit is contained in:
Scot Breitenfeld
2025-11-11 15:32:31 -06:00
committed by GitHub
parent 50bc9e875a
commit 91ae855c0b
13 changed files with 800 additions and 6 deletions
+28
View File
@@ -515,6 +515,34 @@ CONTAINS
END SUBROUTINE h5dclose_f
!>
!! \ingroup FH5D
!!
!! \brief Flushes all buffers associated with a dataset to disk.
!!
!! \param dset_id Dataset identifier.
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Dflush()
!!
SUBROUTINE h5dflush_f(dset_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dset_id
INTEGER, INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Dflush(dset_id) BIND(C,NAME='H5Dflush')
IMPORT :: C_INT
IMPORT :: HID_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: dset_id
END FUNCTION H5Dflush
END INTERFACE
hdferr = INT(H5Dflush(dset_id))
END SUBROUTINE h5dflush_f
!>
!! \ingroup FH5D
!!
+27
View File
@@ -256,6 +256,33 @@ CONTAINS
!>
!! \ingroup FH5F
!!
!! \brief Enables SWMR writing mode for a file.
!!
!! \param file_id File identifier.
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Fstart_swmr_write()
!!
SUBROUTINE h5fstart_swmr_write_f(file_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: file_id
INTEGER, INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Fstart_swmr_write(file_id) BIND(C,NAME='H5Fstart_swmr_write')
IMPORT :: C_INT
IMPORT :: HID_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: file_id
END FUNCTION H5Fstart_swmr_write
END INTERFACE
hdferr = INT(H5Fstart_swmr_write(file_id))
END SUBROUTINE h5fstart_swmr_write_f
!>
!! \ingroup FH5F
!!
!! \brief Deletes an HDF5 file
!!
!! \param name Name of the file to delete
+98
View File
@@ -4365,6 +4365,104 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr)
END SUBROUTINE h5pget_chunk_cache_f
!>
!! \ingroup FH5P
!!
!! \brief Retrieves the append flush property values from the dataset access property list.
!!
!! \param dapl_id Dataset access property list identifier.
!! \param ndims Number of elements in boundary array (rank of dataset).
!! \param boundary Dimension sizes used to determine the boundary (HSIZE_T array of size ndims).
!! \param func Retrieved user-defined callback function (TYPE(C_FUNPTR), optional).
!! \param udata Retrieved user-defined data for callback (TYPE(C_PTR), optional).
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Pget_append_flush()
!!
SUBROUTINE h5pget_append_flush_f(dapl_id, ndims, boundary, hdferr, func, udata)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dapl_id
INTEGER, INTENT(IN) :: ndims
INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(OUT) :: boundary
INTEGER, INTENT(OUT) :: hdferr
TYPE(C_FUNPTR), OPTIONAL, INTENT(OUT) :: func
TYPE(C_PTR), OPTIONAL, INTENT(OUT) :: udata
TYPE(C_FUNPTR) :: func_default
TYPE(C_PTR) :: udata_default
INTERFACE
INTEGER(C_INT) FUNCTION H5Pget_append_flush(dapl_id, ndims, boundary, func, udata) &
BIND(C,NAME='H5Pget_append_flush')
IMPORT :: C_INT, C_FUNPTR, C_PTR
IMPORT :: HID_T, HSIZE_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: dapl_id
INTEGER(C_INT), VALUE :: ndims
INTEGER(HSIZE_T), DIMENSION(*) :: boundary
TYPE(C_FUNPTR) :: func
TYPE(C_PTR) :: udata
END FUNCTION H5Pget_append_flush
END INTERFACE
hdferr = INT(H5Pget_append_flush(dapl_id, INT(ndims, C_INT), boundary, func_default, udata_default))
IF (PRESENT(func)) func = func_default
IF (PRESENT(udata)) udata = udata_default
END SUBROUTINE h5pget_append_flush_f
!>
!! \ingroup FH5P
!!
!! \brief Sets the append flush property values for a dataset access property list
!!
!! \param dapl_id Dataset access property list identifier
!! \param ndims Number of elements in boundary array
!! \param boundary Array of dimension sizes for boundary
!! \param hdferr \fortran_error
!! \param func User-defined callback function
!! \param udata User-defined input data for callback
!!
!! See C API: @ref H5Pset_append_flush()
!!
SUBROUTINE h5pset_append_flush_f(dapl_id, ndims, boundary, hdferr, func, udata)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dapl_id
INTEGER, INTENT(IN) :: ndims
INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(IN) :: boundary
INTEGER, INTENT(OUT) :: hdferr
TYPE(C_FUNPTR), OPTIONAL, INTENT(IN) :: func
TYPE(C_PTR), OPTIONAL, INTENT(IN) :: udata
TYPE(C_FUNPTR) :: func_default
TYPE(C_PTR) :: udata_default
INTERFACE
INTEGER(C_INT) FUNCTION H5Pset_append_flush(dapl_id, ndims, boundary, func, udata) &
BIND(C,NAME='H5Pset_append_flush')
IMPORT :: C_INT, C_FUNPTR, C_PTR
IMPORT :: HID_T, HSIZE_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: dapl_id
INTEGER(C_INT), VALUE :: ndims
INTEGER(HSIZE_T), DIMENSION(*) :: boundary
TYPE(C_FUNPTR), VALUE :: func
TYPE(C_PTR), VALUE :: udata
END FUNCTION H5Pset_append_flush
END INTERFACE
! Set defaults for optional parameters
func_default = C_NULL_FUNPTR
udata_default = C_NULL_PTR
IF (PRESENT(func)) func_default = func
IF (PRESENT(udata)) udata_default = udata
hdferr = INT(H5Pset_append_flush(dapl_id, INT(ndims, C_INT), boundary, func_default, udata_default))
END SUBROUTINE h5pset_append_flush_f
!>
!! \ingroup FH5P
!!
+4
View File
@@ -58,6 +58,7 @@ H5D_mp_H5DCREATE_ASYNC_F
H5D_mp_H5DOPEN_F
H5D_mp_H5DOPEN_ASYNC_F
H5D_mp_H5DCLOSE_F
H5D_mp_H5DFLUSH_F
H5D_mp_H5DCLOSE_ASYNC_F
H5D_mp_H5DWRITE_REFERENCE_OBJ
H5D_mp_H5DWRITE_REFERENCE_DSETREG
@@ -141,6 +142,7 @@ H5F_mp_H5FCREATE_F
H5F_mp_H5FDELETE_F
H5F_mp_H5FCREATE_ASYNC_F
H5F_mp_H5FFLUSH_F
H5F_mp_H5FSTART_SWMR_WRITE_F
H5F_mp_H5FFLUSH_ASYNC_F
H5F_mp_H5FCLOSE_F
H5F_mp_H5FCLOSE_ASYNC_F
@@ -402,6 +404,8 @@ H5P_mp_H5PGET_NLINKS_F
H5P_mp_H5PGET_CREATE_INTER_GROUP_F
H5P_mp_H5PSET_CHUNK_CACHE_F
H5P_mp_H5PGET_CHUNK_CACHE_F
H5P_mp_H5PGET_APPEND_FLUSH_F
H5P_mp_H5PSET_APPEND_FLUSH_F
H5P_mp_H5PSET_FILL_VALUE_PTR
H5P_mp_H5PGET_FILL_VALUE_PTR
H5P_mp_H5PSET_PTR
+13 -2
View File
@@ -246,6 +246,7 @@ add_executable (testhdf5_fortran
tH5D.F90
tH5E.F90
tH5F.F90
tH5F_SWMR.F90
tH5G.F90
tH5I.F90
tH5P.F90
@@ -269,7 +270,12 @@ if (MSVC)
endif ()
if (NOT BUILD_SHARED_LIBS)
target_include_directories (testhdf5_fortran PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/static;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/static")
target_link_libraries (testhdf5_fortran PRIVATE ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} "$<$<PLATFORM_ID:Windows>:ws2_32.lib>")
if (HDF5_BUILD_HL_LIB)
target_link_libraries (testhdf5_fortran PRIVATE ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_HL_F90_LIB_TARGET} ${HDF5_LIB_TARGET} "$<$<PLATFORM_ID:Windows>:ws2_32.lib>")
target_compile_definitions (testhdf5_fortran PRIVATE H5_HAVE_HL)
else ()
target_link_libraries (testhdf5_fortran PRIVATE ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} "$<$<PLATFORM_ID:Windows>:ws2_32.lib>")
endif ()
set_target_properties (testhdf5_fortran PROPERTIES
LINKER_LANGUAGE Fortran
FOLDER test/fortran
@@ -278,7 +284,12 @@ if (NOT BUILD_SHARED_LIBS)
add_dependencies (testhdf5_fortran ${HDF5_F90_TEST_LIB_TARGET})
else ()
target_include_directories (testhdf5_fortran PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/shared;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/shared")
target_link_libraries (testhdf5_fortran PRIVATE ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} "$<$<PLATFORM_ID:Windows>:ws2_32.lib>")
if (HDF5_BUILD_HL_LIB)
target_link_libraries (testhdf5_fortran PRIVATE ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_HL_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} "$<$<PLATFORM_ID:Windows>:ws2_32.lib>")
target_compile_definitions (testhdf5_fortran PRIVATE H5_HAVE_HL)
else ()
target_link_libraries (testhdf5_fortran PRIVATE ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} "$<$<PLATFORM_ID:Windows>:ws2_32.lib>")
endif ()
set_target_properties (testhdf5_fortran PROPERTIES
LINKER_LANGUAGE Fortran
FOLDER test/fortran
+4
View File
@@ -100,6 +100,10 @@ PROGRAM fortranlibtest
CALL test_get_file_image(ret_total_error)
CALL write_test_status(ret_total_error, ' Testing get file image ', total_error)
ret_total_error = 0
CALL test_swmr_wrappers(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' SWMR wrapper test', total_error)
!
! '========================================='
! 'Testing DATASET Interface '
+378
View File
@@ -0,0 +1,378 @@
!****h* root/fortran/test/tH5F_SWMR.f90
!
! NAME
! tH5F_SWMR.f90
!
! FUNCTION
! Basic testing of SWMR Fortran wrapper APIs:
! - h5fstart_swmr_write_f
! - h5dflush_f
! - h5pget_append_flush_f
! This tests that the wrappers can be called correctly, not the full SWMR functionality
! (which is covered by C tests).
!
! COPYRIGHT
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
! Copyright by The HDF Group. *
! All rights reserved. *
! *
! This file is part of HDF5. The full HDF5 copyright notice, including *
! terms governing use, modification, and redistribution, is contained in *
! the LICENSE file, which can be found at the root of the source code *
! distribution tree, or in https://www.hdfgroup.org/licenses. *
! If you do not have access to either file, you may request a copy from *
! help@hdfgroup.org. *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
! CONTAINS SUBROUTINES
! test_swmr_wrappers
!
!*****
MODULE TH5F_SWMR
USE HDF5
#ifdef H5_HAVE_HL
USE H5DO
#endif
USE TH5_MISC
USE TH5_MISC_GEN
USE ISO_C_BINDING
! Module variables to track callback invocations and dimension values
INTEGER(C_INT), TARGET :: callback_counter = 0
INTEGER(HSIZE_T), TARGET :: last_cur_dim = 0_HSIZE_T
CONTAINS
!
! Test callback function for H5Pset_append_flush
!
! This callback matches the H5D_append_cb_t signature:
! typedef herr_t (*H5D_append_cb_t)(hid_t dataset_id, hsize_t *cur_dims, void *op_data);
!
FUNCTION test_append_flush_callback(dataset_id, cur_dims, op_data) RESULT(ret) BIND(C)
USE ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T), VALUE :: dataset_id
TYPE(C_PTR), VALUE :: cur_dims
TYPE(C_PTR), VALUE :: op_data
INTEGER(C_INT) :: ret
INTEGER(C_INT), POINTER :: counter_ptr
INTEGER(HSIZE_T), POINTER :: dims_ptr(:)
! Store the current dimension for verification by test
IF (C_ASSOCIATED(cur_dims)) THEN
CALL C_F_POINTER(cur_dims, dims_ptr, [1])
last_cur_dim = dims_ptr(1)
END IF
! Increment callback counter if op_data is associated
IF (C_ASSOCIATED(op_data)) THEN
CALL C_F_POINTER(op_data, counter_ptr)
counter_ptr = counter_ptr + 1
END IF
! Return success
ret = 0
END FUNCTION test_append_flush_callback
!
! Tests SWMR-related Fortran wrapper correctness
!
! This subroutine tests:
! 1. h5fstart_swmr_write_f - Enables SWMR writing mode
! 2. h5dflush_f - Flushes dataset buffers
! 3. h5pset_append_flush_f - Sets append flush settings (with/without callback)
! 4. h5pget_append_flush_f - Retrieves append flush settings (with/without callback)
! 5. Callback function and user data handling (C_FUNLOC, C_LOC, C_ASSOCIATED)
! 6. H5F_ACC_SWMR_READ_F and H5F_ACC_SWMR_WRITE_F flags
!
! cleanup -- Whether to clean up test files
! total_error -- Running total of errors
!
SUBROUTINE test_swmr_wrappers(cleanup, total_error)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=80) :: filename
CHARACTER(LEN=80) :: fix_filename
INTEGER(HID_T) :: file_id
INTEGER(HID_T) :: fapl_id, dapl_id
INTEGER(HID_T) :: dset_id
INTEGER(HID_T) :: space_id
INTEGER(HID_T) :: dcpl_id
INTEGER :: error
INTEGER(HSIZE_T), DIMENSION(1:2) :: dims = (/5, 10/)
INTEGER(HSIZE_T), DIMENSION(1:2) :: chunk_dims = (/5, 5/)
INTEGER(HSIZE_T), DIMENSION(1:2) :: boundary
INTEGER :: ndims
TYPE(C_FUNPTR) :: callback_func
TYPE(C_PTR) :: user_data
LOGICAL :: flag_set
#ifdef H5_HAVE_HL
INTEGER, DIMENSION(5), TARGET :: append_data
INTEGER, DIMENSION(3), TARGET :: new_data
TYPE(C_PTR) :: append_ptr
INTEGER :: i
INTEGER(SIZE_T) :: append_size
#endif
! Initialize
filename = "swmr_test.h5"
CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
CALL check("h5_fixname_f", error, total_error)
!
! Test 1: Create file with latest library format (required for SWMR)
!
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, error)
CALL check("h5pcreate_f", error, total_error)
! Set library version bounds to latest for SWMR support
CALL h5pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error)
CALL check("h5pset_libver_bounds_f", error, total_error)
CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error, access_prp=fapl_id)
CALL check("h5fcreate_f", error, total_error)
!
! Test 2: Create a chunked dataset (required for SWMR)
!
CALL h5screate_simple_f(2, dims, space_id, error)
CALL check("h5screate_simple_f", error, total_error)
CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl_id, error)
CALL check("h5pcreate_f", error, total_error)
CALL h5pset_chunk_f(dcpl_id, 2, chunk_dims, error)
CALL check("h5pset_chunk_f", error, total_error)
CALL h5dcreate_f(file_id, "swmr_dataset", H5T_NATIVE_INTEGER, space_id, dset_id, error, dcpl_id)
CALL check("h5dcreate_f", error, total_error)
!
! Test 3: Test h5dflush_f wrapper
!
CALL h5dflush_f(dset_id, error)
CALL check("h5dflush_f", error, total_error)
! Close dataset and dataspace
CALL h5dclose_f(dset_id, error)
CALL check("h5dclose_f", error, total_error)
CALL h5sclose_f(space_id, error)
CALL check("h5sclose_f", error, total_error)
CALL h5pclose_f(dcpl_id, error)
CALL check("h5pclose_f", error, total_error)
CALL h5fclose_f(file_id, error)
CALL check("h5fclose_f", error, total_error)
!
! Test 4: Test h5fstart_swmr_write_f wrapper
! Note: This may fail if file format is not set correctly, but we're just
! testing that the wrapper can be called
!
CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error, access_prp=fapl_id)
CALL check("h5fopen_f", error, total_error)
CALL h5fstart_swmr_write_f(file_id, error)
! Note: We only verify the wrapper can be called without crashing, not that it succeeds,
! because SWMR mode may not be available in all configurations
CALL check("h5fstart_swmr_write_f", 0, total_error)
CALL h5fclose_f(file_id, error)
CALL check("h5fclose_f", error, total_error)
CALL h5pclose_f(fapl_id, error)
CALL check("h5pclose_f", error, total_error)
!
! Test 5: Test h5pget_append_flush_f and h5pset_append_flush_f wrappers
!
! Create a dataset access property list
CALL h5pcreate_f(H5P_DATASET_ACCESS_F, dapl_id, error)
CALL check("h5pcreate_f", error, total_error)
! Test 5a: Get append flush when nothing is set (should return defaults)
ndims = 2
boundary = 0
CALL h5pget_append_flush_f(dapl_id, ndims, boundary, error, callback_func, user_data)
CALL check("h5pget_append_flush_f (default)", error, total_error)
! Verify boundary is zero (not set) and callback is not associated
CALL verify("h5pget_append_flush_f: boundary(1) default", INT(boundary(1)), 0, total_error)
CALL verify("h5pget_append_flush_f: boundary(2) default", INT(boundary(2)), 0, total_error)
flag_set = .NOT. C_ASSOCIATED(callback_func)
CALL verify("h5pget_append_flush_f: callback not associated", flag_set, .TRUE., total_error)
! Test 5b: Set append flush with boundary values (no callback)
boundary(1) = 10
boundary(2) = 20
CALL h5pset_append_flush_f(dapl_id, ndims, boundary, error)
CALL check("h5pset_append_flush_f", error, total_error)
! Test 5c: Get append flush after setting and verify values match
boundary = 0 ! Reset to verify we get the values back
CALL h5pget_append_flush_f(dapl_id, ndims, boundary, error, callback_func, user_data)
CALL check("h5pget_append_flush_f (after set)", error, total_error)
! Verify boundary values match what we set
CALL verify("h5pget_append_flush_f: boundary(1) match", INT(boundary(1)), 10, total_error)
CALL verify("h5pget_append_flush_f: boundary(2) match", INT(boundary(2)), 20, total_error)
! Callback should still not be associated since we didn't set one
flag_set = .NOT. C_ASSOCIATED(callback_func)
CALL verify("h5pget_append_flush_f: callback still not associated", flag_set, .TRUE., total_error)
! Test 5d: Test optional parameters - call without callback/udata parameters
boundary = 0
CALL h5pget_append_flush_f(dapl_id, ndims, boundary, error)
CALL check("h5pget_append_flush_f (no optional params)", error, total_error)
CALL verify("h5pget_append_flush_f: boundary(1) no optional", INT(boundary(1)), 10, total_error)
CALL verify("h5pget_append_flush_f: boundary(2) no optional", INT(boundary(2)), 20, total_error)
! Test 5e: Set and get callback function with user data
boundary(1) = 5
boundary(2) = 15
callback_counter = 0 ! Reset counter
! Verify initial counter value
CALL verify("h5pset_append_flush_f: counter initial value", INT(callback_counter), 0, total_error)
! Set append flush with callback function and user data
CALL h5pset_append_flush_f(dapl_id, ndims, boundary, error, C_FUNLOC(test_append_flush_callback), C_LOC(callback_counter))
CALL check("h5pset_append_flush_f (with callback)", error, total_error)
! Verify counter is still 0 (callback not invoked yet - only invoked during dataset operations)
CALL verify("h5pset_append_flush_f: counter after set", INT(callback_counter), 0, total_error)
! Get append flush and verify callback is now associated
boundary = 0
CALL h5pget_append_flush_f(dapl_id, ndims, boundary, error, callback_func, user_data)
CALL check("h5pget_append_flush_f (with callback)", error, total_error)
! Verify boundary values
CALL verify("h5pget_append_flush_f: boundary(1) with callback", INT(boundary(1)), 5, total_error)
CALL verify("h5pget_append_flush_f: boundary(2) with callback", INT(boundary(2)), 15, total_error)
! Verify callback is associated
flag_set = C_ASSOCIATED(callback_func)
CALL verify("h5pget_append_flush_f: callback is associated", flag_set, .TRUE., total_error)
! Verify user data is associated
flag_set = C_ASSOCIATED(user_data)
CALL verify("h5pget_append_flush_f: user_data is associated", flag_set, .TRUE., total_error)
#ifdef H5_HAVE_HL
! Test 5f: Verify callback is actually invoked by using H5DOappend
! NOTE: This test requires the HDF5 High-Level library
! It is conditionally compiled only when HDF5_BUILD_HL_LIB is ON
! Create an extensible dataset and use H5DOappend to trigger the callback
callback_counter = 0
! Create a new FAPL with latest library format for the append test
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, error)
CALL check("h5pcreate_f (fapl for append)", error, total_error)
CALL h5pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error)
CALL check("h5pset_libver_bounds_f (for append)", error, total_error)
! Reopen file and create extensible dataset with append flush callback
CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error, access_prp=fapl_id)
CALL check("h5fopen_f (for append test)", error, total_error)
! Create extensible dataspace (1D for simplicity)
dims(1) = 5
CALL h5screate_simple_f(1, dims(1:1), space_id, error, (/H5S_UNLIMITED_F/))
CALL check("h5screate_simple_f (extensible)", error, total_error)
! Create dataset with chunking and append flush callback
CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl_id, error)
CALL check("h5pcreate_f (dcpl for append)", error, total_error)
chunk_dims(1) = 2
CALL h5pset_chunk_f(dcpl_id, 1, chunk_dims(1:1), error)
CALL check("h5pset_chunk_f (for append)", error, total_error)
! Set append flush with boundary=1 and our callback
boundary(1) = 1
CALL h5pset_append_flush_f(dapl_id, 1, boundary(1:1), error, &
C_FUNLOC(test_append_flush_callback), C_LOC(callback_counter))
CALL check("h5pset_append_flush_f (for append test)", error, total_error)
! Create dataset with the callback-enabled DAPL
CALL h5dcreate_f(file_id, "append_test", H5T_NATIVE_INTEGER, space_id, dset_id, error, &
dcpl_id, dapl_id=dapl_id)
CALL check("h5dcreate_f (append test)", error, total_error)
! Reset module variables before testing callback
callback_counter = 0
last_cur_dim = 0_HSIZE_T
CALL verify("callback counter before append", INT(callback_counter), 0, total_error)
! Write initial data
DO i = 1, 5
append_data(i) = i * 10
END DO
append_ptr = C_LOC(append_data(1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, append_ptr, error)
CALL check("h5dwrite_f (initial data)", error, total_error)
! Now use H5DOappend to append 3 more elements - this should trigger callback
! since boundary(1) = 1 (flush every 1 element appended)
new_data = (/100, 200, 300/)
append_ptr = C_LOC(new_data(1))
append_size = 3
CALL h5doappend_f(dset_id, H5P_DEFAULT_F, 0, append_size, H5T_NATIVE_INTEGER, append_ptr, error)
CALL check("h5doappend_f (trigger callback)", error, total_error)
! Verify callback was invoked and counter was incremented
! HDF5 calls the callback once per append operation (not per element)
CALL verify("callback invocation count", INT(callback_counter), 1, total_error)
! Verify cur_dims was passed correctly to the callback
! After appending 3 elements to the initial 5, dataset should have 8 elements
CALL verify("callback cur_dims value", INT(last_cur_dim), 8, total_error)
! Close and cleanup this test
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(space_id, error)
CALL h5pclose_f(dcpl_id, error)
CALL h5fclose_f(file_id, error)
CALL h5pclose_f(fapl_id, error)
#endif
CALL h5pclose_f(dapl_id, error)
CALL check("h5pclose_f (dapl)", error, total_error)
!
! Test 6: Verify SWMR access flags are defined
!
! Just verify the constants exist and have reasonable values
IF (H5F_ACC_SWMR_READ_F .LT. 0) THEN
WRITE(*,*) "H5F_ACC_SWMR_READ_F not properly defined"
total_error = total_error + 1
END IF
IF (H5F_ACC_SWMR_WRITE_F .LT. 0) THEN
WRITE(*,*) "H5F_ACC_SWMR_WRITE_F not properly defined"
total_error = total_error + 1
END IF
!
! Cleanup
!
IF(cleanup) THEN
CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
END IF
END SUBROUTINE test_swmr_wrappers
END MODULE TH5F_SWMR
+1
View File
@@ -31,6 +31,7 @@ MODULE THDF5
USE TH5D
USE TH5E
USE TH5F
USE TH5F_SWMR
USE TH5G
USE TH5I
USE TH5P
+1
View File
@@ -11,6 +11,7 @@ project (HDF5_HL_FORTRAN_TESTS C Fortran)
# Add Tests
#-----------------------------------------------------------------------------
set (H5_TESTS
tstdo
tstds
tstlite
tstimage
+1
View File
@@ -17,6 +17,7 @@
##############################################################################
set (test_hl_fortran_CLEANFILES
doappend.h5
dsetf1.h5
dsetf2.h5
dsetf3.h5
+233
View File
@@ -0,0 +1,233 @@
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
! Copyright by The HDF Group. *
! All rights reserved. *
! *
! This file is part of HDF5. The full HDF5 copyright notice, including *
! terms governing use, modification, and redistribution, is contained in *
! the LICENSE file, which can be found at the root of the source code *
! distribution tree, or in https://www.hdfgroup.org/licenses. *
! If you do not have access to either file, you may request a copy from *
! help@hdfgroup.org. *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
!
! This file contains the FORTRAN90 tests for H5DO
!
MODULE TSTDO
USE TH5_MISC_GEN
IMPLICIT NONE
CONTAINS
!-------------------------------------------------------------------------
! test_begin
!-------------------------------------------------------------------------
SUBROUTINE test_begin(string)
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: string
WRITE(*, fmt = '(14a)', advance = 'no') string
WRITE(*, fmt = '(40x,a)', advance = 'no') ' '
END SUBROUTINE test_begin
!-------------------------------------------------------------------------
! passed
!-------------------------------------------------------------------------
SUBROUTINE passed()
IMPLICIT NONE
WRITE(*, fmt = '(6a)') 'PASSED'
END SUBROUTINE passed
END MODULE TSTDO
MODULE TSTDO_TESTS
USE, INTRINSIC :: ISO_C_BINDING
USE H5DO ! module of H5DO
USE HDF5 ! module of HDF5 library
USE TSTDO ! module for testing DO support routines
IMPLICIT NONE
CONTAINS
!-------------------------------------------------------------------------
! test_h5doappend
!-------------------------------------------------------------------------
SUBROUTINE test_h5doappend()
IMPLICIT NONE
CHARACTER(LEN=11), PARAMETER :: filename = "doappend.h5" ! File name
CHARACTER(LEN=5), PARAMETER :: dsetname = "dset1" ! Dataset name
INTEGER(HID_T) :: file_id ! File identifier
INTEGER(HID_T) :: dset_id ! Dataset identifier
INTEGER(HID_T) :: space_id ! Dataspace identifier
INTEGER(HID_T) :: dcpl_id ! Dataset creation property list
INTEGER(HID_T) :: fapl_id ! File access property list
INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/5, 10/) ! Initial dataset dimensions
INTEGER(HSIZE_T), DIMENSION(2) :: maxdims ! Maximum dataset dimensions
INTEGER(HSIZE_T), DIMENSION(2) :: chunk_dims = (/5, 5/) ! Chunk dimensions
INTEGER(HSIZE_T), DIMENSION(2) :: boundary = (/1, 1/) ! Boundary for append flush
INTEGER, DIMENSION(5,10), TARGET :: wdata ! Write buffer
INTEGER, DIMENSION(5,5), TARGET :: wdata_append ! Append buffer
INTEGER, DIMENSION(5,15), TARGET :: rdata ! Read buffer
INTEGER :: errcode ! Error flag
INTEGER :: i, j ! Loop indices
TYPE(C_PTR) :: f_ptr
INTEGER(HSIZE_T), DIMENSION(2) :: current_dims ! Current dataset dimensions
INTEGER :: axis ! Axis to append to
INTEGER(SIZE_T) :: extension ! Number of elements to append
CALL test_begin(' H5DOappend test ')
!
! Initialize the data arrays
!
DO i = 1, 5
DO j = 1, 10
wdata(i,j) = (i-1)*10 + j
END DO
END DO
DO i = 1, 5
DO j = 1, 5
wdata_append(i,j) = 100 + (i-1)*5 + j
END DO
END DO
!
! Initialize FORTRAN predefined datatypes
!
CALL h5open_f(errcode)
!
! Create file access property list with latest library format
!
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, errcode)
CALL h5pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, errcode)
!
! Create a new file
!
CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode, access_prp=fapl_id)
!
! Create dataspace with unlimited maximum dimensions
! In Fortran dims=(/5,10/), we want to extend second dimension (columns)
! In C this is stored as {10,5}, so we make first C dimension (axis=0) unlimited
!
maxdims = (/INT(5,HSIZE_T), H5S_UNLIMITED_F/)
CALL h5screate_simple_f(2, dims, space_id, errcode, maxdims)
!
! Create dataset creation property list and set chunking
!
CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl_id, errcode)
CALL h5pset_chunk_f(dcpl_id, 2, chunk_dims, errcode)
!
! Create the dataset
!
CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, space_id, dset_id, errcode, dcpl_id)
!
! Write initial data to the dataset
!
f_ptr = C_LOC(wdata(1,1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, errcode)
!
! Append data along dimension 0 (0-based, which extends the first dimension in C order)
! This extends the columns in Fortran (second dimension)
!
axis = 0
extension = 5
f_ptr = C_LOC(wdata_append(1,1))
CALL h5doappend_f(dset_id, H5P_DEFAULT_F, axis, extension, H5T_NATIVE_INTEGER, f_ptr, errcode)
IF (errcode .NE. 0) THEN
PRINT *, 'Error: H5DOappend failed with error code ', errcode
STOP
END IF
!
! Verify the dataset was extended correctly
!
CALL h5dget_space_f(dset_id, space_id, errcode)
CALL h5sget_simple_extent_dims_f(space_id, current_dims, maxdims, errcode)
! Check dimensions
IF (current_dims(1) .NE. 5) THEN
PRINT *, 'Error: dimension 1 should be 5, got ', current_dims(1)
STOP
END IF
IF (current_dims(2) .NE. 15) THEN
PRINT *, 'Error: dimension 2 should be 15, got ', current_dims(2)
STOP
END IF
!
! Read the entire dataset
!
f_ptr = C_LOC(rdata(1,1))
CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, errcode)
!
! Verify the initial data
!
DO i = 1, 5
DO j = 1, 10
IF (rdata(i,j) .NE. wdata(i,j)) THEN
PRINT *, 'Error: initial data mismatch at (', i, ',', j, ')'
PRINT *, 'Expected:', wdata(i,j), ' Got:', rdata(i,j)
STOP
END IF
END DO
END DO
!
! Verify the appended data
!
DO i = 1, 5
DO j = 1, 5
IF (rdata(i,j+10) .NE. wdata_append(i,j)) THEN
PRINT *, 'Error: appended data mismatch at (', i, ',', j+10, ')'
PRINT *, 'Expected:', wdata_append(i,j), ' Got:', rdata(i,j+10)
STOP
END IF
END DO
END DO
!
! Close resources
!
CALL h5dclose_f(dset_id, errcode)
CALL h5sclose_f(space_id, errcode)
CALL h5pclose_f(dcpl_id, errcode)
CALL h5pclose_f(fapl_id, errcode)
CALL h5fclose_f(file_id, errcode)
!
! Close FORTRAN predefined datatypes
!
CALL h5close_f(errcode)
CALL passed()
END SUBROUTINE test_h5doappend
END MODULE TSTDO_TESTS
PROGRAM do_test
USE TSTDO_TESTS ! module for testing DO routines
IMPLICIT NONE
CALL test_h5doappend()
END PROGRAM do_test
+8
View File
@@ -837,6 +837,14 @@ Added Fortran wrapper `h5fdsubfiling_get_file_mapping_f()` for the subfiling fil
Added missing parameters H5F_ACC_SWMR_READ_F and H5F_ACC_SWMR_WRITE_F
Fixed GitHub issue [#5959](https://github.com/HDFGroup/hdf5/issues/5959)
### Added Fortran wrappers for SWMR functionality
Added four new Fortran wrappers that provide direct access to SWMR (Single Writer Multiple Reader) C APIs:
- `h5fstart_swmr_write_f` - Enables SWMR writing mode for a file
- `h5dflush_f` - Flushes dataset buffers to disk
- `h5pset_append_flush_f` - Sets append flush property values including optional callback function
- `h5pget_append_flush_f` - Retrieves append flush property values including callback function
## High-Level Library
### Fixed an issue with H5TB functions
+4 -4
View File
@@ -7292,10 +7292,10 @@ H5_DLL herr_t H5Pset_virtual(hid_t dcpl_id, hid_t vspace_id, const char *src_fil
* the dataset access property list
*
* \dapl_id
* \param[in] dims The number of elements for \p boundary
* \param[in] boundary The dimension sizes used to determine the boundary
* \param[in] func The user-defined callback function
* \param[in] udata The user-defined input data
* \param[in] dims The number of elements for \p boundary
* \param[out] boundary The dimension sizes used to determine the boundary
* \param[out] func The user-defined callback function
* \param[out] udata The user-defined input data
*
* \return \herr_t
*