summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorLarry Knox <lrknox@hdfgroup.org>2021-08-31 21:25:43 (GMT)
committerGitHub <noreply@github.com>2021-08-31 21:25:43 (GMT)
commitf5709db18e10993de3bc4668ad07b66d14279877 (patch)
tree47d3460af81f87c52d5b2fc3f7774ae7f8aaee83 /fortran
parentf9b8a4728758d0a5b81fffd3905ccff055c7f485 (diff)
downloadhdf5-f5709db18e10993de3bc4668ad07b66d14279877.zip
hdf5-f5709db18e10993de3bc4668ad07b66d14279877.tar.gz
hdf5-f5709db18e10993de3bc4668ad07b66d14279877.tar.bz2
Rework of PR #826 (#972) (#978)
* 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> Co-authored-by: Scot Breitenfeld <brtnfld@hdfgroup.org> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Fff.F904
-rw-r--r--fortran/test/fortranlib_test.F904
-rw-r--r--fortran/test/tH5F.F90122
3 files changed, 127 insertions, 3 deletions
diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90
index f772558..a273431 100644
--- a/fortran/src/H5Fff.F90
+++ b/fortran/src/H5Fff.F90
@@ -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
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.