Fortran Wrappers H5VLnative_addr_to_token_f and H5VLnative_token_to_a…

…ddress_f (HDFGroup#3801) * Added H5VLnative_addr_to_token_f and H5VLnative_token_to_address_f * Added H5VLnative_addr_to_token_f and H5VLnative_token_to_address_f tests
jhendersonHDF · Dec 7, 2023 · c383c2a · c383c2a
1 parent b8aeae0
commit c383c2a
Show file tree

Hide file tree

Showing 4 changed files with 93 additions and 10 deletions.
diff --git a/fortran/src/H5VLff.F90 b/fortran/src/H5VLff.F90
@@ -401,4 +401,68 @@ END FUNCTION H5VLunregister_connector
 
   END SUBROUTINE H5VLunregister_connector_f
 
+!>
+!! \ingroup FH5VL
+!!
+!! \brief Retrieves the token representation from an address for a location identifier.
+!!
+!! \param loc_id Specifies a location identifier
+!! \param addr   Address for object in the file
+!! \param token  Token representing the object in the file
+!! \param hdferr \fortran_error
+!!
+!! See C API: @ref H5VLnative_addr_to_token()
+!!
+  SUBROUTINE h5vlnative_addr_to_token_f(loc_id, addr, token, hdferr)
+    IMPLICIT NONE
+    INTEGER(HID_T)     , INTENT(IN)  :: loc_id
+    INTEGER(HADDR_T)   , INTENT(IN)  :: addr
+    TYPE(H5O_TOKEN_T_F), INTENT(OUT) :: token
+    INTEGER            , INTENT(OUT) :: hdferr
+
+    INTERFACE
+       INTEGER(C_INT) FUNCTION H5VLnative_addr_to_token(loc_id, addr, token) BIND(C, NAME='H5VLnative_addr_to_token')
+         IMPORT :: HID_T, C_INT, HADDR_T, H5O_TOKEN_T_F
+         INTEGER(HID_T)  , VALUE :: loc_id
+         INTEGER(HADDR_T), VALUE :: addr
+         TYPE(H5O_TOKEN_T_F)     :: token
+       END FUNCTION H5VLnative_addr_to_token
+    END INTERFACE
+
+    hdferr = INT(H5VLnative_addr_to_token(loc_id, addr, token))
+
+  END SUBROUTINE h5vlnative_addr_to_token_f
+
+!>
+!! \ingroup FH5VL
+!!
+!! \brief Retrieves the object address from a token representation for a location identifier.
+!!
+!! \param loc_id Specifies a location identifier
+!! \param token  Token representing the object in the file
+!! \param addr   Address for object in the file
+!! \param hdferr \fortran_error
+!!
+!! See C API: @ref H5VLnative_token_to_addr()
+!!
+  SUBROUTINE h5vlnative_token_to_addr_f(loc_id, token, addr, hdferr)
+    IMPLICIT NONE
+    INTEGER(HID_T)     , INTENT(IN)  :: loc_id
+    TYPE(H5O_TOKEN_T_F), INTENT(IN)  :: token
+    INTEGER(HADDR_T)   , INTENT(OUT) :: addr
+    INTEGER            , INTENT(OUT) :: hdferr
+
+    INTERFACE
+       INTEGER(C_INT) FUNCTION H5VLnative_token_to_addr(loc_id, token, addr) BIND(C, NAME='H5VLnative_token_to_addr')
+         IMPORT :: HID_T, C_INT, HADDR_T, H5O_TOKEN_T_F
+         INTEGER(HID_T)     , VALUE :: loc_id
+         TYPE(H5O_TOKEN_T_F), VALUE :: token
+         INTEGER(HADDR_T)           :: addr
+       END FUNCTION H5VLnative_token_to_addr
+    END INTERFACE
+
+    hdferr = INT(H5VLnative_token_to_addr(loc_id, token, addr))
+
+  END SUBROUTINE h5vlnative_token_to_addr_f
+
 END MODULE H5VL
diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in
@@ -553,6 +553,8 @@ H5VL_mp_H5VLGET_CONNECTOR_ID_BY_VALUE_F
 H5VL_mp_H5VLGET_CONNECTOR_NAME_F
 H5VL_mp_H5VLCLOSE_F
 H5VL_mp_H5VLUNREGISTER_CONNECTOR_F
+H5VL_mp_H5VLNATIVE_ADDR_TO_TOKEN_F
+H5VL_mp_H5VLNATIVE_TOKEN_TO_ADDR_F
 ; H5Z
 H5Z_mp_H5ZUNREGISTER_F
 H5Z_mp_H5ZFILTER_AVAIL_F

diff --git a/fortran/test/tH5O_F03.F90 b/fortran/test/tH5O_F03.F90
@@ -73,6 +73,8 @@ INTEGER FUNCTION compare_h5o_info_t( loc_id, oinfo_f, oinfo_c, field, full_f_fie
     INTEGER :: cmp_value
     INTEGER :: i
     INTEGER :: ierr
+    INTEGER(HADDR_T) :: addr
+    TYPE(H5O_TOKEN_T_F) :: token
 
     status = 0
 
@@ -82,7 +84,7 @@ INTEGER FUNCTION compare_h5o_info_t( loc_id, oinfo_f, oinfo_c, field, full_f_fie
           RETURN
        ENDIF
        token_c%token = oinfo_c%token%token
-       CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr);
+       CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr)
        IF( (ierr .EQ. -1) .OR. (cmp_value .NE. 0) ) THEN
           status = -1
           RETURN
@@ -96,6 +98,22 @@ INTEGER FUNCTION compare_h5o_info_t( loc_id, oinfo_f, oinfo_c, field, full_f_fie
           RETURN
        ENDIF
 
+       CALL h5vlnative_token_to_addr_f(loc_id, oinfo_f%token, addr, ierr)
+       IF( ierr .EQ. -1) THEN
+          status = -1
+          RETURN
+       ENDIF
+       CALL h5vlnative_addr_to_token_f(loc_id, addr, token, ierr)
+       IF( ierr .EQ. -1) THEN
+          status = -1
+          RETURN
+       ENDIF
+       CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token, cmp_value, ierr)
+       IF( (ierr .EQ. -1) .OR. (cmp_value .NE. 0) ) THEN
+          status = -1
+          RETURN
+       ENDIF
+
     ENDIF
 
     IF((field .EQ. H5O_INFO_TIME_F).OR.(field .EQ. H5O_INFO_ALL_F))THEN
@@ -132,7 +150,7 @@ INTEGER FUNCTION compare_h5o_info_t( loc_id, oinfo_f, oinfo_c, field, full_f_fie
        status = 0
        IF( oinfo_c%fileno .NE. oinfo_f%fileno) status = status + 1
        token_c%token = oinfo_c%token%token
-       CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr);
+       CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr)
        IF( (ierr .EQ. -1) .OR. (cmp_value .NE. 0) ) THEN
           status = -1
           RETURN
@@ -156,7 +174,7 @@ INTEGER FUNCTION compare_h5o_info_t( loc_id, oinfo_f, oinfo_c, field, full_f_fie
        status = 0
        IF( oinfo_c%fileno .NE. oinfo_f%fileno) status = status + 1
        token_c%token = oinfo_c%token%token
-       CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr);
+       CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr)
        IF( (ierr .EQ. -1) .OR. (cmp_value .NE. 0) ) THEN
           status = -1
           RETURN
@@ -234,25 +252,24 @@ INTEGER FUNCTION visit_obj_cb( group_id, name, oinfo_c, op_data) bind(C)
     ENDIF
 
     ! Check H5Oget_info_by_name_f; if partial field values were filled correctly
-    CALL H5Oget_info_by_name_f(group_id, name2, oinfo_f, ierr);
+    CALL H5Oget_info_by_name_f(group_id, name2, oinfo_f, ierr)
     visit_obj_cb =  compare_h5o_info_t( group_id, oinfo_f, oinfo_c, op_data%field, .TRUE. )
     IF(visit_obj_cb.EQ.-1) RETURN
 
     ! Check H5Oget_info_by_name_f, only check field values
-    CALL H5Oget_info_by_name_f(group_id, name2, oinfo_f, ierr, fields = op_data%field);
+    CALL H5Oget_info_by_name_f(group_id, name2, oinfo_f, ierr, fields = op_data%field)
     visit_obj_cb =  compare_h5o_info_t(group_id, oinfo_f, oinfo_c, op_data%field, .FALSE. )
     IF(visit_obj_cb.EQ.-1) RETURN
 
-
     IF(op_data%idx.EQ.1)THEN
 
        ! Check H5Oget_info_f, only check field values
-       CALL H5Oget_info_f(group_id, oinfo_f, ierr, fields = op_data%field);
+       CALL H5Oget_info_f(group_id, oinfo_f, ierr, fields = op_data%field)
        visit_obj_cb =  compare_h5o_info_t(group_id, oinfo_f, oinfo_c, op_data%field, .FALSE.  )
        IF(visit_obj_cb.EQ.-1) RETURN
 
        ! Check H5Oget_info_f; if partial field values where filled correctly
-       CALL H5Oget_info_f(group_id, oinfo_f, ierr);
+       CALL H5Oget_info_f(group_id, oinfo_f, ierr)
        visit_obj_cb =  compare_h5o_info_t(group_id, oinfo_f, oinfo_c, op_data%field, .TRUE.  )
        IF(visit_obj_cb.EQ.-1) RETURN
 
@@ -677,7 +694,6 @@ SUBROUTINE test_obj_info(total_error)
      CALL check("h5oget_info_by_idx_f", -1, total_error)
   ENDIF
 
-
   ! Close objects
   CALL h5dclose_f(did, error)
   CALL check("h5dclose_f", error, total_error)

diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt
@@ -62,7 +62,8 @@ New Features
 
     Fortran Library:
     ----------------
-    -
+    - Added Fortran APIs:
+      h5vlnative_addr_to_token_f and h5vlnative_token_to_address_f
 
 
     C++ Library: