Skip to content

Commit

Permalink
Added H5Fdelete_f with test (HDFGroup#3912)
Browse files Browse the repository at this point in the history
  • Loading branch information
brtnfld authored Dec 30, 2023
1 parent 3a21ee0 commit 2fc1400
Show file tree
Hide file tree
Showing 4 changed files with 85 additions and 13 deletions.
43 changes: 40 additions & 3 deletions fortran/src/H5Fff.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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
!>
Expand Down
1 change: 1 addition & 0 deletions fortran/src/hdf5_fortrandll.def.in
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
51 changes: 41 additions & 10 deletions fortran/test/tH5F.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
3 changes: 3 additions & 0 deletions release_docs/RELEASE.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down

0 comments on commit 2fc1400

Please sign in to comment.