Skip to content

Commit

Permalink
Rework of PR #826 (#972)
Browse files Browse the repository at this point in the history
*    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>
  • Loading branch information
brtnfld and github-actions[bot] authored Aug 30, 2021
1 parent 794acf4 commit 01fe254
Show file tree
Hide file tree
Showing 4 changed files with 133 additions and 3 deletions.
4 changes: 2 additions & 2 deletions fortran/src/H5Fff.F90
Original file line number Diff line number Diff line change
Expand Up @@ -824,7 +824,7 @@ END SUBROUTINE h5fget_freespace_f
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,
Expand All @@ -844,7 +844,7 @@ INTEGER FUNCTION h5fget_name_c(obj_id, size, buf, buflen) &
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
Expand Down
4 changes: 4 additions & 0 deletions fortran/test/fortranlib_test.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
122 changes: 121 additions & 1 deletion fortran/test/tH5F.F90
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,8 @@
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
! CONTAINS SUBROUTINES
! mountingtest, reopentest, plisttest, file_close, file_space
! mountingtest, reopentest, get_name_test, plisttest,
! file_close, file_space
!
!*****
!
Expand Down Expand Up @@ -580,6 +581,125 @@ SUBROUTINE reopentest(cleanup, total_error)

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

0 comments on commit 01fe254

Please sign in to comment.