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>

2 files changed, 125 insertions, 1 deletions

diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90
index eff4657..1640a8f 100644
--- a/fortran/test/fortranlib_test.F90
+++ b/fortran/test/fortranlib_test.F90
@@ -74,6 +74,10 @@ PROGRAM fortranlibtest
   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)
 
diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90
index f4a3232..06dc6de 100644
--- a/fortran/test/tH5F.F90
+++ b/fortran/test/tH5F.F90
@@ -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.