Rework of PR #826 (#972)

*    H5Fget_name_f fixed to handle correctly trailing whitespaces and newly allocated buffers.

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
This commit is contained in:
Scot Breitenfeld 2021-08-30 09:56:32 -05:00 committed by GitHub
parent 794acf489f
commit 01fe2549a3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 133 additions and 3 deletions

View File

@ -824,7 +824,7 @@ CONTAINS
SUBROUTINE h5fget_name_f(obj_id, buf, size, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier
CHARACTER(LEN=*), INTENT(INOUT) :: buf
CHARACTER(LEN=*), INTENT(OUT) :: buf
! Buffer to hold file name
INTEGER(SIZE_T), INTENT(OUT) :: size ! Size of the file name
INTEGER, INTENT(OUT) :: hdferr ! Error code: 0 on success,
@ -844,7 +844,7 @@ CONTAINS
CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: buf
END FUNCTION h5fget_name_c
END INTERFACE
buflen = LEN_TRIM(buf)
buflen = LEN(buf)
hdferr = h5fget_name_c(obj_id, size, buf, buflen)
END SUBROUTINE h5fget_name_f
!****s* H5F/h5fget_filesize_f

View File

@ -73,6 +73,10 @@ PROGRAM fortranlibtest
CALL reopentest(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' Reopen test', total_error)
ret_total_error = 0
CALL get_name_test(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' Get name test', total_error)
ret_total_error = 0
CALL file_close(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' File open/close test', total_error)

View File

@ -21,7 +21,8 @@
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
! CONTAINS SUBROUTINES
! mountingtest, reopentest, plisttest, file_close, file_space
! mountingtest, reopentest, get_name_test, plisttest,
! file_close, file_space
!
!*****
!
@ -580,6 +581,125 @@ CONTAINS
END SUBROUTINE reopentest
! The following subroutine checks that h5fget_name_f produces
! correct output for a given obj_id and filename.
!
SUBROUTINE check_get_name(obj_id, fix_filename, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
INTEGER(HID_T) :: obj_id ! Object identifier
CHARACTER(LEN=80), INTENT(IN) :: fix_filename ! Expected filename
INTEGER, INTENT(INOUT) :: total_error ! Error count
CHARACTER(LEN=80):: file_name ! Filename buffer
INTEGER:: error ! HDF5 error code
INTEGER(SIZE_T):: name_size ! Filename length
!
!Get file name from the dataset identifier
!
! Use an uninitialized buffer
CALL h5fget_name_f(obj_id, file_name, name_size, error)
CALL check("h5fget_name_f",error,total_error)
IF(name_size .NE. LEN_TRIM(fix_filename))THEN
WRITE(*,*) " file name size obtained from the object id is incorrect"
total_error = total_error + 1
ENDIF
IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN
WRITE(*,*) " file name obtained from the object id is incorrect"
total_error = total_error + 1
END IF
! Use a buffer initialized with spaces
file_name(:) = " "
CALL h5fget_name_f(obj_id, file_name, name_size, error)
CALL check("h5fget_name_f",error,total_error)
IF(name_size .NE. LEN_TRIM(fix_filename))THEN
WRITE(*,*) " file name size obtained from the object id is incorrect"
total_error = total_error + 1
ENDIF
IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN
WRITE(*,*) " file name obtained from the object id is incorrect"
total_error = total_error + 1
END IF
! Use a buffer initialized with non-whitespace characters
file_name(:) = "a"
CALL h5fget_name_f(obj_id, file_name, name_size, error)
CALL check("h5fget_name_f",error,total_error)
IF(name_size .NE. LEN_TRIM(fix_filename))THEN
WRITE(*,*) " file name size obtained from the object id is incorrect"
total_error = total_error + 1
ENDIF
IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN
WRITE(*,*) " file name obtained from the object id is incorrect"
total_error = total_error + 1
END IF
END SUBROUTINE check_get_name
! The following subroutine tests h5fget_name_f.
! It creates the file which has name "filename.h5" and
! tests that h5fget_name_f also returns the name "filename.h5"
!
SUBROUTINE get_name_test(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=*), PARAMETER :: filename = "filename"
CHARACTER(LEN=80) :: fix_filename
INTEGER(HID_T) :: file_id ! File identifier
INTEGER(HID_T) :: g_id ! Group identifier
!
! Flag to check operation success
!
INTEGER :: error
!
! Create file "filename.h5" using default properties.
!
CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
IF (error .NE. 0) THEN
WRITE(*,*) "Cannot modify filename"
STOP
ENDIF
CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error)
CALL check("h5fcreate_f",error,total_error)
!
! Create group.
!
CALL h5gopen_f(file_id,"/",g_id, error)
CALL check("h5gopen_f",error,total_error)
CALL check_get_name(file_id, fix_filename, total_error)
CALL check_get_name(g_id, fix_filename, total_error)
! Close the group.
!
CALL h5gclose_f(g_id, error)
CALL check("h5gclose_f",error,total_error)
!
! Close the file identifiers.
!
CALL h5fclose_f(file_id, error)
CALL check("h5fclose_f",error,total_error)
IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
RETURN
END SUBROUTINE get_name_test
!
! The following example demonstrates how to get creation property list,
! and access property list.

View File

@ -745,6 +745,12 @@ New Features
Fortran Library:
----------------
- H5Fget_name_f fixed to handle correctly trailing whitespaces and
newly allocated buffers.
(MSB - 2021/08/30, github-826,972)
- Add wrappers for H5Pset/get_file_locking() API calls
h5pget_file_locking_f()