diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index 34529824086..d597bcf306a 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -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 !! diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index 7051e95bec8..fad1ff8a993 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -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 diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index a8a0e91c193..072df4ca488 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -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 !! diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 9cece35d1c7..bd629b0ae4f 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -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 diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index 5c34919047f..ddaf438a609 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -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} "$<$: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} "$<$: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} "$<$: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} "$<$: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} "$<$: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} "$<$:ws2_32.lib>") + endif () set_target_properties (testhdf5_fortran PROPERTIES LINKER_LANGUAGE Fortran FOLDER test/fortran diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index bace2bf86f9..16301f4bb1a 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -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 ' diff --git a/fortran/test/tH5F_SWMR.F90 b/fortran/test/tH5F_SWMR.F90 new file mode 100644 index 00000000000..1948c7d2935 --- /dev/null +++ b/fortran/test/tH5F_SWMR.F90 @@ -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 diff --git a/fortran/test/tHDF5.F90 b/fortran/test/tHDF5.F90 index 3669bf13408..7383ef23409 100644 --- a/fortran/test/tHDF5.F90 +++ b/fortran/test/tHDF5.F90 @@ -31,6 +31,7 @@ MODULE THDF5 USE TH5D USE TH5E USE TH5F + USE TH5F_SWMR USE TH5G USE TH5I USE TH5P diff --git a/hl/fortran/test/CMakeLists.txt b/hl/fortran/test/CMakeLists.txt index 3ea63297455..4ab8939987b 100644 --- a/hl/fortran/test/CMakeLists.txt +++ b/hl/fortran/test/CMakeLists.txt @@ -11,6 +11,7 @@ project (HDF5_HL_FORTRAN_TESTS C Fortran) # Add Tests #----------------------------------------------------------------------------- set (H5_TESTS + tstdo tstds tstlite tstimage diff --git a/hl/fortran/test/CMakeTests.cmake b/hl/fortran/test/CMakeTests.cmake index bbecfce4119..717433c0228 100644 --- a/hl/fortran/test/CMakeTests.cmake +++ b/hl/fortran/test/CMakeTests.cmake @@ -17,6 +17,7 @@ ############################################################################## set (test_hl_fortran_CLEANFILES + doappend.h5 dsetf1.h5 dsetf2.h5 dsetf3.h5 diff --git a/hl/fortran/test/tstdo.F90 b/hl/fortran/test/tstdo.F90 new file mode 100644 index 00000000000..2ee4ede43fe --- /dev/null +++ b/hl/fortran/test/tstdo.F90 @@ -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 diff --git a/release_docs/CHANGELOG.md b/release_docs/CHANGELOG.md index 9125c2444c0..8b493cbcaa5 100644 --- a/release_docs/CHANGELOG.md +++ b/release_docs/CHANGELOG.md @@ -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 diff --git a/src/H5Ppublic.h b/src/H5Ppublic.h index 68021727703..1d334961f36 100644 --- a/src/H5Ppublic.h +++ b/src/H5Ppublic.h @@ -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 *