summaryrefslogtreecommitdiffstats
path: root/fortran/test
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2021-08-30 14:56:32 (GMT)
committerGitHub <noreply@github.com>2021-08-30 14:56:32 (GMT)
commit01fe2549a36d7635b2cbe6f6a57cbcce29c1335b (patch)
tree889541417f0b7ca57f117b647d59365079768608 /fortran/test
parent794acf489fa093a3a119723c7cea74cb2880624b (diff)
downloadhdf5-01fe2549a36d7635b2cbe6f6a57cbcce29c1335b.zip
hdf5-01fe2549a36d7635b2cbe6f6a57cbcce29c1335b.tar.gz
hdf5-01fe2549a36d7635b2cbe6f6a57cbcce29c1335b.tar.bz2
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>
Diffstat (limited to 'fortran/test')
-rw-r--r--fortran/test/fortranlib_test.F904
-rw-r--r--fortran/test/tH5F.F90122
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.