HDFGroup · lrknox · Apr 19, 2022 · Apr 19, 2022 · Apr 19, 2022
@@ -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;

@@ -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

@@ -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

@@ -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
      !

@@ -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 )

@@ -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

@@ -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

@@ -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
 ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

@@ -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