Skip to content

Commit

Permalink
Fortran Wrappers H5VLnative_addr_to_token_f and H5VLnative_token_to_a…
Browse files Browse the repository at this point in the history
…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

* Added H5VLnative_addr_to_token_f and H5VLnative_token_to_address_f tests
  • Loading branch information
brtnfld authored Nov 3, 2023
1 parent 5e78774 commit 6a3c859
Show file tree
Hide file tree
Showing 4 changed files with 95 additions and 9 deletions.
64 changes: 64 additions & 0 deletions fortran/src/H5VLff.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
2 changes: 2 additions & 0 deletions fortran/src/hdf5_fortrandll.def.in
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
34 changes: 25 additions & 9 deletions fortran/test/tH5O_F03.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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)
Expand Down
4 changes: 4 additions & 0 deletions release_docs/RELEASE.txt
Original file line number Diff line number Diff line change
Expand Up @@ -335,6 +335,10 @@ New Features

Fortran Library:
----------------

- Added Fortran APIs:
h5vlnative_addr_to_token_f and h5vlnative_token_to_address_f

- Fixed an uninitialized error return value for hdferr
to return the error state of the h5aopen_by_idx_f API.

Expand Down

0 comments on commit 6a3c859

Please sign in to comment.