Revised Tests

brtnfld · Apr 26, 2024 · 00f3d29 · 00f3d29
1 parent 6adb13f
commit 00f3d29
Show file tree

Hide file tree

Showing 5 changed files with 99 additions and 132 deletions.
diff --git a/configure.ac b/configure.ac
@@ -13,7 +13,7 @@
 ## ----------------------------------------------------------------------
 ## Initialize configure.
 ##
-AC_PREREQ([2.69])
+AC_PREREQ([2.71])
 
 ## AC_INIT takes the name of the package, the version number, and an
 ## email address to report bugs. AC_CONFIG_SRCDIR takes a unique file

diff --git a/fortran/src/H5Rff.F90 b/fortran/src/H5Rff.F90
@@ -946,14 +946,9 @@ END SUBROUTINE h5rdestroy_f
 !! \param hdferr   \fortran_error
 !! \param oapl_id  Object access property list identifier
 !!
-#ifdef H5_DOXYGEN
 !! See C API: @ref H5Rcreate_object()
 !!
-  SUBROUTINE h5rcreate_object_f(&
-#else
-  SUBROUTINE h5rcreate_object_f(&
-#endif
-       loc_id, name, ref, hdferr, oapl_id)
+  SUBROUTINE h5rcreate_object_f(loc_id, name, ref, hdferr, oapl_id)
     USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
     IMPLICIT NONE
     INTEGER(HID_T)  , INTENT(IN) :: loc_id
@@ -985,11 +980,7 @@ END FUNCTION H5Rcreate_object
 
     hdferr = INT(H5Rcreate_object(loc_id, c_name, oapl_id_default, ref))
 
-#ifdef H5_DOXYGEN
   END SUBROUTINE h5rcreate_object_f
-#else
-  END SUBROUTINE h5rcreate_object_f
-#endif
 !>
 !! \ingroup FH5R
 !!

diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90
@@ -142,8 +142,8 @@ PROGRAM fortranlibtest
 !      '========================================='
 
   ret_total_error = 0
-  CALL reftest3(cleanup, ret_total_error)
-  CALL write_test_status(ret_total_error, ' Version 3 References test', total_error)
+  CALL v3reftest(cleanup, ret_total_error)
+  CALL write_test_status(ret_total_error, ' Version 3 references test', total_error)
 
   ret_total_error = 0
   CALL refobjtest(cleanup, ret_total_error)

diff --git a/fortran/test/tH5R.F90 b/fortran/test/tH5R.F90
@@ -473,26 +473,28 @@ SUBROUTINE refregtest(cleanup, total_error)
   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 refregtest
 
-SUBROUTINE reftest3(cleanup, total_error)
+SUBROUTINE v3reftest(cleanup, total_error)
   IMPLICIT NONE
   LOGICAL, INTENT(IN)  :: cleanup
   INTEGER, INTENT(INOUT) :: total_error
 
-  CHARACTER(LEN=12), PARAMETER :: filename = "genreference"
-  CHARACTER(LEN=80) :: fix_filename
-  CHARACTER(LEN=8), PARAMETER :: dsetnamei = "INTEGERS"
-  CHARACTER(LEN=17), PARAMETER :: dsetnamer = "OBJECT_REFERENCES"
-  CHARACTER(LEN=6), PARAMETER :: groupname1 = "GROUP1"
-  CHARACTER(LEN=6), PARAMETER :: groupname2 = "GROUP2"
-  INTEGER, PARAMETER :: ref_size = 6
+  CHARACTER(LEN=11), PARAMETER :: filename = "v3reference"
+  CHARACTER(LEN=8) , PARAMETER :: dsetnamei  = "INTEGERS"
+  CHARACTER(LEN=17), PARAMETER :: dsetnamer  = "OBJECT_REFERENCES"
+  CHARACTER(LEN=6) , PARAMETER :: groupname1 = "GROUP1"
+  CHARACTER(LEN=6) , PARAMETER :: groupname2 = "GROUP2"
+  INTEGER          , PARAMETER :: ref_size = 6
+  INTEGER          , PARAMETER :: arr_size = 5
+  INTEGER          , PARAMETER :: rank = 1
+  INTEGER          , PARAMETER :: datawrite_size = 2
 
+  CHARACTER(LEN=80) :: fix_filename
   INTEGER(HID_T) :: file_id       ! File identifier
   INTEGER(HID_T) :: grp1_id       ! Group identifier
   INTEGER(HID_T) :: grp2_id       ! Group identifier
@@ -501,25 +503,17 @@ SUBROUTINE reftest3(cleanup, total_error)
   INTEGER(HID_T) :: type_id       ! Type identifier
   INTEGER(HID_T) :: space_id      ! Dataspace identifier
   INTEGER(HID_T) :: spacer_id     ! Dataspace identifier
-  INTEGER(HID_T) :: sid, sid2, aid, dspace_id, dspace_id1
-  INTEGER     ::   error, ref_type
-  INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/5/)
+  INTEGER(HID_T) :: sid, sid2, aid, aid2, dspace_id, dspace_id1
+  INTEGER        :: error, ref_type
+  INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/arr_size/)
   INTEGER(HSIZE_T), DIMENSION(1) :: dimsr= (/ref_size/)
-  INTEGER(HSIZE_T), DIMENSION(1) :: my_maxdims = (/5/)
-  INTEGER :: rank = 1
-  INTEGER :: rankr = 1
   INTEGER :: i
-  TYPE(hobj_ref_t_f), DIMENSION(4) ::  ref
-  TYPE(hobj_ref_t_f), DIMENSION(4) ::  ref_out
   TYPE(H5R_ref_t), DIMENSION(ref_size), TARGET :: ref_ptr
-  TYPE(H5R_ref_t), DIMENSION(2), TARGET :: ref_ptr2
-  TYPE(H5R_ref_t), DIMENSION(ref_size), TARGET :: ref_ptr_out
+  TYPE(H5R_ref_t), DIMENSION(ref_size), TARGET :: ref_ptr_read
   TYPE(H5R_ref_t), TARGET :: ref_ptr_cp
-  INTEGER(HSIZE_T), DIMENSION(1) :: ref_dim
-  INTEGER, DIMENSION(5), TARGET :: DATA = (/1, 2, 3, 4, 5/)
-  INTEGER, DIMENSION(2), TARGET :: data_pt = (/100,500/)
-  INTEGER(HSIZE_T), DIMENSION(2) :: data_dims
-  INTEGER(HSIZE_T), DIMENSION(1) :: dimspt
+  INTEGER, DIMENSION(arr_size), TARGET :: DATA = (/1, 2, 3, 4, 5/)
+  INTEGER, DIMENSION(2), TARGET :: data_write = (/100, 500/)
+  INTEGER(HSIZE_T), DIMENSION(rank) :: dimspt = (/datawrite_size/)
   INTEGER(HSIZE_T), DIMENSION(1:2) :: coord
 
 #ifdef H5_FORTRAN_HAVE_CHAR_ALLOC
@@ -532,6 +526,8 @@ SUBROUTINE reftest3(cleanup, total_error)
   LOGICAL :: ref_eq
   INTEGER(hssize_t) :: num_points_ret
 
+  INTEGER(HID_T) :: memspace
+
   !
   ! Create a new file with Default file access and
   ! file creation properties.
@@ -561,6 +557,9 @@ SUBROUTINE reftest3(cleanup, total_error)
   CALL H5Acreate_f(grp2_id, "ATTR1", H5T_NATIVE_INTEGER, sid, aid, error)
   CALL check("H5Acreate_f",error,total_error)
 
+  !
+  ! Create an attribute
+  !
   a_data = 20
   f_ptr = C_LOC(a_data)
   CALL H5Awrite_f(aid, H5T_NATIVE_INTEGER, f_ptr, error)
@@ -569,22 +568,20 @@ SUBROUTINE reftest3(cleanup, total_error)
   !
   ! Create dataspaces for datasets
   !
-  CALL h5screate_simple_f(rank, dims, space_id, error, maxdims=my_maxdims)
+  CALL h5screate_simple_f(rank, dims, space_id, error)
   CALL check("h5screate_simple_f",error,total_error)
-  CALL h5screate_simple_f(rankr, dimsr, spacer_id, error)
+  CALL h5screate_simple_f(rank, dimsr, spacer_id, error)
   CALL check("h5screate_simple_f",error,total_error)
 
   !
   ! Create integer dataset
   !
-  CALL h5dcreate_f(file_id, dsetnamei, H5T_NATIVE_INTEGER, space_id, &
-       dset1_id, error)
+  CALL h5dcreate_f(file_id, dsetnamei, H5T_NATIVE_INTEGER, space_id, dset1_id, error)
   CALL check("h5dcreate_f",error,total_error)
   !
   ! Create dataset to store references to the objects
   !
-  CALL h5dcreate_f(file_id, dsetnamer, H5T_STD_REF, spacer_id, &
-       dsetr_id, error)
+  CALL h5dcreate_f(file_id, dsetnamer, H5T_STD_REF, spacer_id, dsetr_id, error)
   CALL check("h5dcreate_f",error,total_error)
   !
   ! Create a datatype and store in the file
@@ -616,7 +613,6 @@ SUBROUTINE reftest3(cleanup, total_error)
   ! Create references to two groups, integer dataset and shared datatype
   ! and write it to the dataset in the file
   !
-  ! FIX: MSB: ref values are never set.
 
   f_ptr = C_LOC(ref_ptr(1))
   CALL h5rcreate_object_f(file_id, groupname1, f_ptr, error)
@@ -631,21 +627,16 @@ SUBROUTINE reftest3(cleanup, total_error)
   CALL h5rcreate_object_f(file_id, "MyType", f_ptr, error)
   CALL check("h5rcreate_f",error,total_error)
 
-  !CALL h5eset_auto_f(1, error)
   f_ptr = C_LOC(ref_ptr(5))
-  CALL h5rcreate_attr_f(file_id, dsetnamei, "ATTR1", f_ptr, error, H5P_DEFAULT_F)
+  CALL h5rcreate_attr_f(file_id, "/GROUP1/GROUP2", "ATTR1", f_ptr, error, H5P_DEFAULT_F)
   CALL check("h5rcreate_attr_f",error,total_error)
 
-  f_ptr = C_LOC(ref_ptr2(2))
-
-  dimspt(1) = 2
   CALL h5screate_simple_f(1, dimspt, sid2, error)
   CALL check("h5screate_simple_f",error,total_error)
 
-  coord(1) = 1 !1
-  coord(2) = 5 ! dims(1)
-  !CALL h5sselect_elements_f(sid2, H5S_SELECT_SET_F, 1, SIZE(coord,KIND=SIZE_T), coord, error)
-  CALL h5sselect_elements_f(sid2, H5S_SELECT_SET_F, 1, 2_SIZE_T, coord, error)
+  coord(1) = 1
+  coord(2) = dims(1)
+  CALL h5sselect_elements_f(sid2, H5S_SELECT_SET_F, 1, SIZE(coord,KIND=SIZE_T), coord, error)
   CALL check("h5sselect_elements_f",error,total_error)
 
   f_ptr = C_LOC(ref_ptr(6))
@@ -657,10 +648,6 @@ SUBROUTINE reftest3(cleanup, total_error)
   CALL h5dwrite_f(dsetr_id, H5T_STD_REF, f_ptr, error)
   CALL check("h5dwrite_f",error,total_error)
 
-!  f_ptr = C_LOC(ref_ptr2(1))
-!  CALL h5dwrite_f(dsetr_id, H5T_STD_REF, f_ptr, error)
-!  CALL check("h5dwrite_f",error,total_error)
-
   CALL h5rget_obj_name_f(C_LOC(ref_ptr(3)), "", error, H5P_DEFAULT_F, buf_size)
   CALL check("h5rget_obj_name_f", error, total_error)
   CALL verify("h5rget_obj_name_f", buf_size, LEN(dsetnamei,KIND=SIZE_T)+1, total_error)
@@ -750,129 +737,112 @@ SUBROUTINE reftest3(cleanup, total_error)
   CALL h5dopen_f(file_id, dsetnamer,dsetr_id,error)
   CALL check("h5dopen_f",error,total_error)
 
-  f_ptr = C_LOC(ref_ptr_out(1))
+  f_ptr = C_LOC(ref_ptr_read(1))
   CALL h5dread_f(dsetr_id, H5T_STD_REF, f_ptr, error)
   CALL check("h5dread_f",error,total_error)
 
   !
   !get the third reference's type and Dereference it
   !
-  CALL h5rget_obj_name_f(C_LOC(ref_ptr_out(1)), buf_big, error)
-  CALL check("H5Rget_name_f", error, total_error)
-  CALL verify("H5Rget_name_f", TRIM(buf_big), "/GROUP1", total_error)
-  CALL h5rget_obj_name_f(C_LOC(ref_ptr_out(2)), buf_big, error)
-  CALL check("H5Rget_name_f", error, total_error)
-  CALL verify("H5Rget_name_f", TRIM(buf_big), "/GROUP1/GROUP2", total_error)
-  CALL h5rget_obj_name_f(C_LOC(ref_ptr_out(3)), buf_big, error)
-  CALL check("H5Rget_name_f", error, total_error)
-  CALL verify("H5Rget_name_f1", TRIM(buf_big), "/"//dsetnamei, total_error)
-  CALL h5rget_obj_name_f(C_LOC(ref_ptr_out(4)), buf_big, error)
-  CALL check("H5Rget_name_f", error, total_error)
-  CALL verify("H5Rget_name_f2", TRIM(buf_big), "/"//"MyType", total_error)
-  CALL h5rget_type_f(C_LOC(ref_ptr_out(1)), ref_type, error)
+  CALL h5rget_obj_name_f(C_LOC(ref_ptr_read(1)), buf_big, error)
+  CALL check("h5rget_obj_name_f", error, total_error)
+  CALL verify("h5rget_obj_name_f", TRIM(buf_big), "/GROUP1", total_error)
+  CALL h5rget_obj_name_f(C_LOC(ref_ptr_read(2)), buf_big, error)
+  CALL check("h5rget_obj_name_f", error, total_error)
+  CALL verify("h5rget_obj_name_f", TRIM(buf_big), "/GROUP1/GROUP2", total_error)
+  CALL h5rget_obj_name_f(C_LOC(ref_ptr_read(3)), buf_big, error)
+  CALL check("h5rget_obj_name_f", error, total_error)
+  CALL verify("h5rget_obj_name_f", TRIM(buf_big), "/"//dsetnamei, total_error)
+  CALL h5rget_obj_name_f(C_LOC(ref_ptr_read(4)), buf_big, error)
+  CALL check("h5rget_obj_name_f", error, total_error)
+  CALL verify("h5rget_obj_name_f", TRIM(buf_big), "/"//"MyType", total_error)
+
+  CALL h5rget_attr_name_f(C_LOC(ref_ptr_read(5)), buf_big, error)
+  CALL check("h5rget_attr_name_f", error, total_error)
+  CALL verify("h5rget_attr_name_f", TRIM(buf_big), "ATTR1", total_error)
+
+  CALL h5ropen_attr_f( C_LOC(ref_ptr_read(5)), aid2, error, H5P_DEFAULT_F, H5P_DEFAULT_F )
+  CALL check("h5ropen_attr_f",error,total_error)
+
+  CALL h5aget_name_f(aid2, 16_size_t, buf_big, error)
+  CALL check("h5aget_name_f",error,total_error)
+  CALL verify("h5aget_name_f", TRIM(buf_big), "ATTR1", total_error)
+
+  CALL h5aclose_f(aid2, error)
+  CALL check("h5aclose_f", error, total_error)
+
+  CALL h5rget_type_f(C_LOC(ref_ptr_read(1)), ref_type, error)
   CALL check("h5rget_type_f", error, total_error)
   CALL verify("h5rget_type_f", ref_type, H5R_OBJECT2_F, total_error)
 
   IF (ref_type == H5R_OBJECT2_F) THEN
-    CALL h5ropen_object_f(C_LOC(ref_ptr_out(3)), dset1_id, error, H5P_DEFAULT_F)
+    CALL h5ropen_object_f(C_LOC(ref_ptr_read(3)), dset1_id, error, H5P_DEFAULT_F)
     CALL check("h5ropen_object_f", error, total_error)
 
     CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, C_LOC(data(1)), error)
     CALL check("h5dwrite_f",error,total_error)
 
-    CALL h5rdestroy_f(C_LOC(ref_ptr_out(3)), error)
+    CALL h5rdestroy_f(C_LOC(ref_ptr_read(3)), error)
     CALL check("h5rdestroy_f", error, total_error)
 
     CALL h5oclose_f(dset1_id, error)
     CALL check("h5oclose_f1",error,total_error)
 
   END IF
 
-  CALL h5rget_type_f(C_LOC(ref_ptr_out(6)), ref_type, error)
+  CALL h5rget_type_f(C_LOC(ref_ptr_read(6)), ref_type, error)
   CALL check("h5rget_type_f", error, total_error)
-  CALL VERIFY("h5rget_type_f", ref_type, H5R_DATASET_REGION2_F, total_error)
 
   IF(ref_type .EQ. H5R_DATASET_REGION2_F)THEN
-    CALL h5ropen_object_f(C_LOC(ref_ptr_out(6)), dset1_id, error, H5P_DEFAULT_F)
-
-    CALL H5Dget_space_f(dset1_id, dspace_id1, error)
-    CALL check("H5Dget_space_f",error,total_error)
-    CALL H5Sget_simple_extent_npoints_f(dspace_id1, num_points_ret, error)
-    CALL VERIFY("H5Sget_simple_extent_npoints_f", num_points_ret, dims(1), total_error)
-
-    CALL h5ropen_region_f(C_LOC(ref_ptr_out(6)), dspace_id, error, H5P_DEFAULT_F)
-    CALL check("h5ropen_object_f", error, total_error)
+     CALL h5ropen_object_f(C_LOC(ref_ptr_read(6)), dset1_id, error, H5P_DEFAULT_F)
 
-    CALL h5sget_select_elem_npoints_f(dspace_id, num_points_ret, error)
-    CALL check("h5sget_select_elem_npoints_f",error,total_error)
-    CALL VERIFY("h5sget_simple_extent_npoints_f", num_points_ret, 2_HSIZE_T, total_error)
+     CALL H5Dget_space_f(dset1_id, dspace_id1, error)
+     CALL check("H5Dget_space_f",error,total_error)
+     CALL H5Sget_simple_extent_npoints_f(dspace_id1, num_points_ret, error)
+     CALL VERIFY("H5Sget_simple_extent_npoints_f", num_points_ret, dims(1), total_error)
 
-    coord = -1
-    CALL H5Sget_select_elem_pointlist_f(dspace_id, 0_hsize_t, 2_hsize_t, coord, error)
-    PRINT*,coord
+     CALL h5ropen_region_f(C_LOC(ref_ptr_read(6)), dspace_id, error, H5P_DEFAULT_F)
+     CALL check("h5ropen_object_f", error, total_error)
 
-   ! CALL h5rget_region_f(dset1_id, C_LOC(ref_ptr_out(6))
+     CALL h5screate_simple_f(1, dimspt, memspace, error)
+     CALL check("h5screate_simple_f",error,total_error)
 
-!    CALL h5dopen(file_id, dsetnamei, did, error)
-    CALL h5eset_auto_f(1, error)
-    PRINT*,data_pt(:)
-    f_ptr =  C_LOC(data_pt(1))
-    CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, f_ptr, error, H5S_ALL_F, dspace_id)
-    CALL check("h5dwrite_f",error,total_error)
-
-    CALL h5rdestroy_f(C_LOC(ref_ptr_out(6)), error)
-    CALL check("h5rdestroy_f", error, total_error)
-
-    CALL h5oclose_f(dset1_id, error)
-    CALL check("h5oclose_f",error,total_error)
-  END IF
-  stop
-
- ! CALL h5eset_auto_f(1, error)
-  IF (ref_type == H5G_DATASET_F) THEN
-     CALL h5rdereference_f(dsetr_id, ref(3), dset1_id, error)
-     CALL check("h5rdereference_f",error,total_error)
+     CALL h5sget_select_elem_npoints_f(dspace_id, num_points_ret, error)
+     CALL check("h5sget_select_elem_npoints_f",error,total_error)
+     CALL VERIFY("h5sget_simple_extent_npoints_f", num_points_ret, 2_HSIZE_T, total_error)
 
-     data_dims(1) = 5
-     CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, DATA, data_dims, error)
+     f_ptr =  C_LOC(data_write(1))
+     CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, f_ptr, error, memspace, dspace_id)
      CALL check("h5dwrite_f",error,total_error)
-  END IF
 
+     CALL h5rdestroy_f(C_LOC(ref_ptr_read(6)), error)
+     CALL check("h5rdestroy_f", error, total_error)
 
-#if 0
- ! CALL h5rget_object_type_f(dsetr_id, ref(3), _type, error)
-  !
-  !get the fourth reference's type and Dereference it
-  !
-  CALL h5rget_object_type_f(dsetr_id, ref(4), obj_type, error)
-  CALL check("h5rget_object_type_f",error,total_error)
-  IF (obj_type == H5G_TYPE_F) THEN
-     CALL h5rdereference_f(dsetr_id, ref(4), type_id, error)
-     CALL check("h5rdereference_f",error,total_error)
+     CALL h5oclose_f(dset1_id, error)
+     CALL check("h5oclose_f",error,total_error)
+  ELSE
+     CALL check("h5rget_type_f", -1, total_error)
   END IF
-#endif
+
   !
   ! Close all objects.
   !
-!  CALL h5dclose_f(dset1_id, error)
-!  CALL check("h5dclose_f",error,total_error)
-!  CALL h5tclose_f(type_id, error)
-!  CALL check("h5tclose_f",error,total_error)
 
   CALL h5dclose_f(dsetr_id, error)
   CALL check("h5dclose_f",error,total_error)
   CALL h5fclose_f(file_id, error)
   CALL check("h5fclose_f",error,total_error)
 
   DO i = 1, 4
-     CALL h5rdestroy_f(C_LOC(ref_ptr_out(i)), error)
+     CALL h5rdestroy_f(C_LOC(ref_ptr_read(i)), error)
      CALL check("h5rdestroy_f", error, total_error)
   END DO
 
-!  IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
-!  CALL check("h5_cleanup_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 reftest3
+END SUBROUTINE v3reftest
 
 END MODULE TH5R