mirror of
https://github.com/HDFGroup/hdf5.git
synced 2025-03-25 17:00:45 +08:00
* 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:
parent
794acf489f
commit
01fe2549a3
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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.
|
||||
|
@ -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()
|
||||
|
Loading…
x
Reference in New Issue
Block a user