From 32ef796e470da3e4de364d8dc469b03f5f6fafdc Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Tue, 19 Apr 2022 13:05:54 -0500 Subject: [PATCH] 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 --- fortran/src/H5_f.c | 12 ++-- fortran/src/H5_ff.F90 | 11 ++++ fortran/test/fortranlib_test.F90 | 20 +++++-- fortran/test/tH5A.F90 | 2 +- fortran/test/tH5A_1_8.F90 | 12 ++-- fortran/test/tH5F.F90 | 99 +++++++++++++++++++++++++++++++- fortran/test/tH5G_1_8.F90 | 2 +- fortran/test/tHDF5.F90 | 2 +- fortran/test/tHDF5_F03.F90 | 2 +- 9 files changed, 139 insertions(+), 23 deletions(-) diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index 0277e5cb68d..468debefbbf 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -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. */ - /* 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++) { if (IntKinds_SizeOf[i] == sizeof(char)) { 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 */ } + /* 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 ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value; diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index 350d978e2bb..0aa4b041ee1 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -250,6 +250,9 @@ END FUNCTION h5init1_flags_c 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) H5T_NATIVE_INTEGER_KIND(1:5) = predef_types(1:5) @@ -668,6 +671,7 @@ END SUBROUTINE h5open_f ! October 13, 2011 ! Fortran90 Interface: SUBROUTINE h5close_f(error) + USE H5F, ONLY : h5fget_obj_count_f, H5OPEN_NUM_OBJ IMPLICIT NONE INTEGER, INTENT(OUT) :: error !***** @@ -685,10 +689,17 @@ INTEGER FUNCTION h5close_types_c(p_types, P_TYPES_LEN, & INTEGER(HID_T), DIMENSION(1:I_TYPES_LEN) :: i_types END FUNCTION h5close_types_c 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, & floating_types, FLOATING_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 !****s* H5LIB/h5get_libversion_f diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index 1640a8f8bb1..998b481b9ca 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -37,19 +37,27 @@ PROGRAM fortranlibtest INTEGER :: ret_total_error 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 check("h5open_f",error,total_error) cleanup = .TRUE. CALL h5_env_nocleanup_f(status) 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(*, '(".")', advance="NO") WRITE(*, '(I0)', advance="NO") minnum diff --git a/fortran/test/tH5A.F90 b/fortran/test/tH5A.F90 index 2e76dadb686..115ce700146 100644 --- a/fortran/test/tH5A.F90 +++ b/fortran/test/tH5A.F90 @@ -376,7 +376,7 @@ SUBROUTINE attribute_test(cleanup, total_error) ! Open file ! 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 ! diff --git a/fortran/test/tH5A_1_8.F90 b/fortran/test/tH5A_1_8.F90 index cd8a98164a7..a825f9d9fed 100644 --- a/fortran/test/tH5A_1_8.F90 +++ b/fortran/test/tH5A_1_8.F90 @@ -317,7 +317,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) CALL check("h5pclose_f",error,total_error) 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 check("h5dopen_f",error,total_error) @@ -432,7 +432,7 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) ! Re-open file 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 CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) @@ -1163,7 +1163,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) ! Re-open file 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 IF(test_shared.EQ.2) THEN @@ -1827,7 +1827,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) ! Re-open file 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 @@ -2048,7 +2048,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) ! Re-open file 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 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 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 CALL h5dopen_f(fid, DSET1_NAME, dataset, error, H5P_DEFAULT_F ) diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90 index 8d4845daf48..eb370168562 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -22,7 +22,7 @@ ! ! CONTAINS SUBROUTINES ! mountingtest, reopentest, get_name_test, plisttest, -! file_close, file_space +! file_close, file_space, h5openclose ! !***** ! @@ -35,6 +35,103 @@ MODULE TH5F 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) USE HDF5 ! This module contains all necessary modules USE TH5_MISC diff --git a/fortran/test/tH5G_1_8.F90 b/fortran/test/tH5G_1_8.F90 index 222ba9d3888..bdecd8d8336 100644 --- a/fortran/test/tH5G_1_8.F90 +++ b/fortran/test/tH5G_1_8.F90 @@ -1923,7 +1923,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error) ! Open file 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 a non-default lapl with udata set to point to the first group diff --git a/fortran/test/tHDF5.F90 b/fortran/test/tHDF5.F90 index db829af980f..2bd373d6e2d 100644 --- a/fortran/test/tHDF5.F90 +++ b/fortran/test/tHDF5.F90 @@ -7,7 +7,7 @@ ! src/fortran/test/tHDF5.f90 ! ! PURPOSE -! This is the test module used for testing the Fortran90 HDF library APIs. +! This is the test module used for testing the Fortran90 HDF library APIs. ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * diff --git a/fortran/test/tHDF5_F03.F90 b/fortran/test/tHDF5_F03.F90 index 6d318ea2fd1..1194b1e2570 100644 --- a/fortran/test/tHDF5_F03.F90 +++ b/fortran/test/tHDF5_F03.F90 @@ -7,7 +7,7 @@ ! src/fortran/test/tHDF5_F03.f90 ! ! PURPOSE -! This is the test module used for testing the Fortran2003 HDF +! This is the test module used for testing the Fortran2003 HDF ! library APIS. ! ! COPYRIGHT