diff options
Diffstat (limited to 'fortran/test')
| -rw-r--r-- | fortran/test/fortranlib_test.F90 | 4 | ||||
| -rw-r--r-- | fortran/test/tH5F.F90 | 122 |
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. |