HDFFV-11306 Fixed (#1657)

* HDFFV-11306,
 * Fixed it so both h5open_f and h5close_f can be called multiple times.
 * Fixed an issue with open objects remaining after h5close_f was called.
 * Added additional tests.

* comments clean-up
This commit is contained in:
Scot Breitenfeld
2022-04-19 13:05:54 -05:00
committed by GitHub
parent 14da68ebff
commit 32ef796e47
9 changed files with 139 additions and 23 deletions

View File

@@ -65,12 +65,6 @@ h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *integertypes)
* Find the HDF5 type of the Fortran Integer KIND. * Find the HDF5 type of the Fortran Integer KIND.
*/ */
/* Initialized INTEGER KIND types to default to native integer */
for (i = 0; i < 5; i++) {
if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0)
return ret_value;
}
for (i = 0; i < H5_FORTRAN_NUM_INTEGER_KINDS; i++) { for (i = 0; i < H5_FORTRAN_NUM_INTEGER_KINDS; i++) {
if (IntKinds_SizeOf[i] == sizeof(char)) { if (IntKinds_SizeOf[i] == sizeof(char)) {
if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0)
@@ -96,6 +90,12 @@ h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *integertypes)
} /*end else */ } /*end else */
} }
/* Initialized missing INTEGER KIND types to default to native integer */
for (i = H5_FORTRAN_NUM_INTEGER_KINDS; i < 5; i++) {
if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0)
return ret_value;
}
if (sizeof(int_f) == sizeof(int)) { if (sizeof(int_f) == sizeof(int)) {
if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0)
return ret_value; return ret_value;

View File

@@ -250,6 +250,9 @@ CONTAINS
END INTERFACE END INTERFACE
! Check if H5open_f has already been called. If so, skip doing it again.
IF(H5OPEN_NUM_OBJ .NE. 0) RETURN
error = h5init_types_c(predef_types, floating_types, integer_types) error = h5init_types_c(predef_types, floating_types, integer_types)
H5T_NATIVE_INTEGER_KIND(1:5) = predef_types(1:5) H5T_NATIVE_INTEGER_KIND(1:5) = predef_types(1:5)
@@ -668,6 +671,7 @@ CONTAINS
! October 13, 2011 ! October 13, 2011
! Fortran90 Interface: ! Fortran90 Interface:
SUBROUTINE h5close_f(error) SUBROUTINE h5close_f(error)
USE H5F, ONLY : h5fget_obj_count_f, H5OPEN_NUM_OBJ
IMPLICIT NONE IMPLICIT NONE
INTEGER, INTENT(OUT) :: error INTEGER, INTENT(OUT) :: error
!***** !*****
@@ -685,10 +689,17 @@ CONTAINS
INTEGER(HID_T), DIMENSION(1:I_TYPES_LEN) :: i_types INTEGER(HID_T), DIMENSION(1:I_TYPES_LEN) :: i_types
END FUNCTION h5close_types_c END FUNCTION h5close_types_c
END INTERFACE END INTERFACE
! Check if h5close_f has already been called. Skip doing it again.
IF(H5OPEN_NUM_OBJ .EQ. 0) RETURN
error = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & error = h5close_types_c(predef_types, PREDEF_TYPES_LEN, &
floating_types, FLOATING_TYPES_LEN, & floating_types, FLOATING_TYPES_LEN, &
integer_types, INTEGER_TYPES_LEN ) integer_types, INTEGER_TYPES_LEN )
! Reset the number of open objects from h5open_f to zero
CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, H5OPEN_NUM_OBJ, error)
END SUBROUTINE h5close_f END SUBROUTINE h5close_f
!****s* H5LIB/h5get_libversion_f !****s* H5LIB/h5get_libversion_f

View File

@@ -37,19 +37,27 @@ PROGRAM fortranlibtest
INTEGER :: ret_total_error INTEGER :: ret_total_error
LOGICAL :: cleanup, status LOGICAL :: cleanup, status
WRITE(*,*) ' ========================== '
WRITE(*,*) ' FORTRAN tests '
WRITE(*,*) ' ========================== '
ret_total_error = 0
CALL h5openclose(ret_total_error)
CALL write_test_status(ret_total_error, ' h5open/h5close test', total_error)
CALL h5open_f(error) CALL h5open_f(error)
CALL check("h5open_f",error,total_error)
cleanup = .TRUE. cleanup = .TRUE.
CALL h5_env_nocleanup_f(status) CALL h5_env_nocleanup_f(status)
IF(status) cleanup=.FALSE. IF(status) cleanup=.FALSE.
WRITE(*,*) ' ========================== '
WRITE(*,*) ' FORTRAN tests '
WRITE(*,*) ' ========================== '
CALL h5get_libversion_f(majnum, minnum, relnum, total_error)
IF(total_error .EQ. 0) THEN
WRITE(*, '(" FORTRANLIB_TEST is linked with HDF5 Library version ")', advance="NO") ret_total_error = 0
CALL h5get_libversion_f(majnum, minnum, relnum, ret_total_error)
IF(ret_total_error .EQ. 0) THEN
WRITE(*, '(/," FORTRANLIB_TEST is linked with HDF5 Library version ")', advance="NO")
WRITE(*, '(I0)', advance="NO") majnum WRITE(*, '(I0)', advance="NO") majnum
WRITE(*, '(".")', advance="NO") WRITE(*, '(".")', advance="NO")
WRITE(*, '(I0)', advance="NO") minnum WRITE(*, '(I0)', advance="NO") minnum

View File

@@ -376,7 +376,7 @@ CONTAINS
! Open file ! Open file
! !
CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error) CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error)
CALL check("h5open_f",error,total_error) CALL check("h5fopen_f",error,total_error)
! !
! Reopen dataset ! Reopen dataset
! !

View File

@@ -317,7 +317,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
CALL check("h5pclose_f",error,total_error) CALL check("h5pclose_f",error,total_error)
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
CALL check("h5open_f",error,total_error) CALL check("h5fopen_f",error,total_error)
CALL h5dopen_f(fid, DSET1_NAME, dset1, error) CALL h5dopen_f(fid, DSET1_NAME, dset1, error)
CALL check("h5dopen_f",error,total_error) CALL check("h5dopen_f",error,total_error)
@@ -432,7 +432,7 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
! Re-open file ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error) CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error)
CALL check("h5open_f",error,total_error) CALL check("h5fopen_f",error,total_error)
! Create dataspace for dataset attributes ! Create dataspace for dataset attributes
CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error) CALL check("h5screate_f",error,total_error)
@@ -1163,7 +1163,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
! Re-open file ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl) CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl)
CALL check("h5open_f",error,total_error) CALL check("h5fopen_f",error,total_error)
! Commit datatype to file ! Commit datatype to file
IF(test_shared.EQ.2) THEN IF(test_shared.EQ.2) THEN
@@ -1827,7 +1827,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
! Re-open file ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl) CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl)
CALL check("h5open_f",error,total_error) CALL check("h5fopen_f",error,total_error)
! Commit datatype to file ! Commit datatype to file
@@ -2048,7 +2048,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
! Re-open file ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
CALL check("h5open_f",error,total_error) CALL check("h5fopen_f",error,total_error)
! Create dataspace for dataset ! Create dataspace for dataset
CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL h5screate_f(H5S_SCALAR_F, sid, error)
@@ -2325,7 +2325,7 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
! Re-open file ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
CALL check("h5open_f",error,total_error) CALL check("h5fopen_f",error,total_error)
! Open dataset created ! Open dataset created
CALL h5dopen_f(fid, DSET1_NAME, dataset, error, H5P_DEFAULT_F ) CALL h5dopen_f(fid, DSET1_NAME, dataset, error, H5P_DEFAULT_F )

View File

@@ -22,7 +22,7 @@
! !
! CONTAINS SUBROUTINES ! CONTAINS SUBROUTINES
! mountingtest, reopentest, get_name_test, plisttest, ! mountingtest, reopentest, get_name_test, plisttest,
! file_close, file_space ! file_close, file_space, h5openclose
! !
!***** !*****
! !
@@ -35,6 +35,103 @@ MODULE TH5F
CONTAINS CONTAINS
SUBROUTINE h5openclose(total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
!
! flag to check operation success
!
INTEGER :: error
INTEGER(SIZE_T) :: obj_count ! open object count
INTEGER, DIMENSION(1:5) :: obj_type ! open object type to check
INTEGER :: i, j
DO j = 1, 2
CALL h5open_f(error)
CALL check("h5open_f",error,total_error)
obj_type(1) = H5F_OBJ_ALL_F
obj_type(2) = H5F_OBJ_FILE_F
obj_type(3) = H5F_OBJ_GROUP_F
obj_type(4) = H5F_OBJ_DATASET_F
obj_type(5) = H5F_OBJ_DATATYPE_F
CALL h5close_f(error)
CALL check("h5close_f",error,total_error)
! Check all the datatypes created during h5open_f are closed in h5close_f
DO i = 1, 5
CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), obj_type(i), obj_count, error)
CALL check("h5fget_obj_count_f",error,total_error)
IF(obj_count.NE.0)THEN
total_error = total_error + 1
ENDIF
ENDDO
ENDDO
! Test calling h5open_f multiple times without calling h5close_f
DO j = 1, 4
CALL h5open_f(error)
CALL check("h5open_f",error,total_error)
ENDDO
CALL h5close_f(error)
CALL check("h5close_f",error,total_error)
! Check all the datatypes created during h5open_f are closed in h5close_f
DO i = 1, 5
CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), obj_type(i), obj_count, error)
CALL check("h5fget_obj_count_f",error,total_error)
IF(obj_count.NE.0)THEN
total_error = total_error + 1
ENDIF
ENDDO
! Test calling h5open_f multiple times with a h5close_f in the series of h5open_f
DO j = 1, 5
CALL h5open_f(error)
CALL check("h5open_f",error,total_error)
IF(j.EQ.3)THEN
CALL h5close_f(error)
CALL check("h5close_f",error,total_error)
! Check all the datatypes created during h5open_f are closed in h5close_f
DO i = 1, 5
CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), obj_type(i), obj_count, error)
CALL check("h5fget_obj_count_f",error,total_error)
IF(obj_count.NE.0)THEN
total_error = total_error + 1
ENDIF
ENDDO
ENDIF
ENDDO
CALL h5close_f(error)
CALL check("h5close_f",error,total_error)
! Check all the datatypes created during h5open_f are closed in h5close_f
DO i = 1, 5
CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), obj_type(i), obj_count, error)
CALL check("h5fget_obj_count_f",error,total_error)
IF(obj_count.NE.0)THEN
total_error = total_error + 1
ENDIF
ENDDO
! Check calling h5close_f after already calling h5close_f
CALL h5close_f(error)
CALL check("h5close_f",error,total_error)
! Check all the datatypes created during h5open_f are closed in h5close_f
DO i = 1, 5
CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), obj_type(i), obj_count, error)
CALL check("h5fget_obj_count_f",error,total_error)
IF(obj_count.NE.0)THEN
total_error = total_error + 1
ENDIF
ENDDO
RETURN
END SUBROUTINE h5openclose
SUBROUTINE mountingtest(cleanup, total_error) SUBROUTINE mountingtest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules USE HDF5 ! This module contains all necessary modules
USE TH5_MISC USE TH5_MISC

View File

@@ -1923,7 +1923,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
! Open file ! Open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
CALL check("h5open_f",error,total_error) CALL check("h5fopen_f",error,total_error)
! Create LAPL with higher-than-usual nlinks value ! Create LAPL with higher-than-usual nlinks value
! Create a non-default lapl with udata set to point to the first group ! Create a non-default lapl with udata set to point to the first group