From 2fc140079b861b6efeede10ca6d796276657a9ff Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Sat, 30 Dec 2023 17:33:31 -0600 Subject: [PATCH] Added H5Fdelete_f with test (#3912) --- fortran/src/H5Fff.F90 | 43 +++++++++++++++++++++++-- fortran/src/hdf5_fortrandll.def.in | 1 + fortran/test/tH5F.F90 | 51 ++++++++++++++++++++++++------ release_docs/RELEASE.txt | 3 ++ 4 files changed, 85 insertions(+), 13 deletions(-) diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index d31117784e5..79aa5a7a34b 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -256,6 +256,43 @@ END SUBROUTINE h5fflush_f !> !! \ingroup FH5F !! +!! \brief Deletes an HDF5 file +!! +!! \param name Name of the file to delete +!! \param hdferr \fortran_error +!! \param access_prp File access property list identifier +!! +!! See C API: @ref H5Fdelete() +!! + SUBROUTINE h5fdelete_f(name, hdferr, access_prp) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: access_prp + + INTEGER(HID_T) :: access_prp_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + + INTERFACE + INTEGER(C_INT) FUNCTION H5Fdelete(name, access_prp_default) BIND(C,NAME='H5Fdelete') + IMPORT :: C_CHAR, C_INT + IMPORT :: HID_T + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(HID_T), VALUE :: access_prp_default + END FUNCTION H5Fdelete + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + + access_prp_default = H5P_DEFAULT_F + IF (PRESENT(access_prp)) access_prp_default = access_prp + + hdferr = INT(H5Fdelete(c_name, access_prp_default)) + + END SUBROUTINE h5fdelete_f +!> +!! \ingroup FH5F +!! !! \brief Asynchronously flushes all buffers associated with a file to disk. !! !! \param object_id Identifier of object used to identify the file. @@ -285,7 +322,7 @@ SUBROUTINE h5fflush_async_f(object_id, scope, es_id, hdferr, file, func, line) INTEGER(KIND=C_INT) :: line_default = 0 INTERFACE - INTEGER FUNCTION H5Fflush_async(file, func, line, object_id, scope, es_id) & + INTEGER(C_INT) FUNCTION H5Fflush_async(file, func, line, object_id, scope, es_id) & BIND(C,NAME='H5Fflush_async') IMPORT :: C_CHAR, C_INT, C_PTR IMPORT :: HID_T @@ -303,8 +340,8 @@ END FUNCTION H5Fflush_async IF(PRESENT(func)) func_default = func IF(PRESENT(line)) line_default = INT(line, C_INT) - hdferr = H5Fflush_async(file_default, func_default, line_default, & - object_id, INT(scope, C_INT), es_id) + hdferr = INT(H5Fflush_async(file_default, func_default, line_default, & + object_id, INT(scope, C_INT), es_id)) END SUBROUTINE h5fflush_async_f !> diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 55f4f2b579b..119e140e399 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -121,6 +121,7 @@ H5ES_mp_H5ESGET_ERR_COUNT_F H5ES_mp_H5ESCLOSE_F ; H5F H5F_mp_H5FCREATE_F +H5F_mp_H5FDELETE_F H5F_mp_H5FCREATE_ASYNC_F H5F_mp_H5FFLUSH_F H5F_mp_H5FFLUSH_ASYNC_F diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90 index b4d973e6844..7f9490b7d20 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -479,10 +479,11 @@ SUBROUTINE mountingtest(cleanup, total_error) total_error = total_error + 1 ENDIF - if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) + IF(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) + IF(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) + RETURN END SUBROUTINE mountingtest @@ -853,7 +854,9 @@ SUBROUTINE plisttest(cleanup, total_error) INTEGER(HID_T) :: access_id ! File Access property list identifier !flag to check operation success - INTEGER :: error + INTEGER :: error + !file status + LOGICAL :: status ! !Create a file1 using default properties. @@ -920,10 +923,37 @@ SUBROUTINE plisttest(cleanup, total_error) CALL h5fclose_f(file2_id, error) CALL check("h5fclose_f",error,total_error) - if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) + ! Test file deletion + CALL h5fis_accessible_f(filename1, status, error) + CALL check("h5fis_accessible_f",error,total_error) + IF ( .NOT. status ) THEN + WRITE(*,*) "ERROR: File ", filename1, " is not accessible as hdf5" + END IF + + CALL h5fdelete_f(filename1, error, H5P_DEFAULT_F) + CALL check("h5fdelete_f", error, total_error) + + INQUIRE(FILE=filename1, EXIST=status) + IF ( status ) THEN + WRITE(*,*) "ERROR: File ", filename1, " was not removed by H5Fdelete_f" + END IF + + CALL h5fis_accessible_f(filename2, status, error) + CALL check("h5fis_accessible_f",error,total_error) + IF ( .NOT. status ) THEN + WRITE(*,*) "ERROR: File ", filename2, " is not accessible as hdf5" + total_error=total_error + 1 + END IF + + CALL h5fdelete_f(filename2, error) + CALL check("h5fdelete_f", error, total_error) + + INQUIRE(FILE=filename2, EXIST=status) + IF ( status ) THEN + WRITE(*,*) "ERROR: File ", filename2, " was not removed by H5Fdelete_f" + total_error=total_error + 1 + END IF + RETURN END SUBROUTINE plisttest @@ -1320,6 +1350,7 @@ SUBROUTINE test_get_file_image(total_error) TYPE(C_PTR) :: f_ptr ! Pointer INTEGER(hid_t) :: fapl ! File access property INTEGER :: error ! Error flag + CHARACTER(LEN=18), PARAMETER :: filename="tget_file_image.h5" ! Create new properties for file access CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) @@ -1330,7 +1361,7 @@ SUBROUTINE test_get_file_image(total_error) CALL check("h5pset_fapl_stdio_f", error, total_error) ! Create the file - CALL h5fcreate_f("tget_file_image.h5", H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) CALL check("h5fcreate_f", error, total_error) ! Set up data space for new data set @@ -1357,7 +1388,7 @@ SUBROUTINE test_get_file_image(total_error) CALL check("h5fflush_f",error, total_error) ! Open the test file using standard I/O calls - OPEN(UNIT=10,FILE='tget_file_image.h5', ACCESS='STREAM') + OPEN(UNIT=10,FILE=filename, ACCESS='STREAM') ! Get the size of the test file ! ! Since we use the eoa to calculate the image size, the file size @@ -1406,7 +1437,7 @@ SUBROUTINE test_get_file_image(total_error) ALLOCATE(file_image_ptr(1:image_size)) ! Open the test file using standard I/O calls - OPEN(UNIT=10,FILE='tget_file_image.h5', FORM='UNFORMATTED', ACCESS='STREAM') + OPEN(UNIT=10,FILE=filename, FORM='UNFORMATTED', ACCESS='STREAM') ! Read the test file from disk into the buffer DO i = 1, image_size diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt index dda38522fb8..1a40da7ee46 100644 --- a/release_docs/RELEASE.txt +++ b/release_docs/RELEASE.txt @@ -388,6 +388,9 @@ New Features Fortran Library: ---------------- + - Added Fortran APIs: + h5fdelete_f + - Added Fortran APIs: h5vlnative_addr_to_token_f and h5vlnative_token_to_address_f