Skip to content

Commit

Permalink
Merge branch 'HDFGroup:develop' into ECP-344_develop
Browse files Browse the repository at this point in the history
  • Loading branch information
vchoi-hdfgroup authored Nov 7, 2023
2 parents b919f73 + 3c07147 commit 6d10906
Show file tree
Hide file tree
Showing 21 changed files with 360 additions and 141 deletions.
2 changes: 1 addition & 1 deletion fortran/src/H5Off.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1263,7 +1263,7 @@ SUBROUTINE h5oget_info_by_idx_f(loc_id, group_name, index_field, order, n, &
INTERFACE
INTEGER FUNCTION h5oget_info_by_idx_c(loc_id, group_name, namelen, &
index_field, order, n, lapl_id_default, object_info, fields) BIND(C, NAME='h5oget_info_by_idx_c')
IMPORT :: c_char, c_ptr, c_funptr
IMPORT :: c_char, c_ptr
IMPORT :: HID_T, SIZE_T, HSIZE_T
INTEGER(HID_T) , INTENT(IN) :: loc_id
CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: group_name
Expand Down
70 changes: 0 additions & 70 deletions fortran/src/H5Pf.c
Original file line number Diff line number Diff line change
Expand Up @@ -69,30 +69,6 @@ h5pcreate_c(hid_t_f *cls, hid_t_f *prp_id)
return ret_value;
}

/****if* H5Pf/h5pclose_c
* NAME
* h5pclose_c
* PURPOSE
* Call H5Pclose to close property lis
* INPUTS
* prp_id - identifier of the property list to be closed
* RETURNS
* 0 on success, -1 on failure
* SOURCE
*/

int_f
h5pclose_c(hid_t_f *prp_id)
/******/
{
int_f ret_value = 0;

if (H5Pclose((hid_t)*prp_id) < 0)
ret_value = -1;

return ret_value;
}

/****if* H5Pf/h5pcopy_c
* NAME
* h5pcopy_c
Expand Down Expand Up @@ -2252,52 +2228,6 @@ h5pget_hyper_vector_size_c(hid_t_f *prp_id, size_t_f *size)
return ret_value;
}

/****if* H5Pf/h5pcreate_class_c
* NAME
* h5pcreate_class_c
* PURPOSE
* Call H5Pcreate_class ito create a new property class
* INPUTS
* parent - property list class identifier
* name - name of the new class
* name_len - length of the "name" buffer
* OUTPUTS
* class - new class identifier
* RETURNS
* 0 on success, -1 on failure
* SOURCE
*/
int_f
h5pcreate_class_c(hid_t_f *parent, _fcd name, int_f *name_len, hid_t_f *cls, H5P_cls_create_func_t create,
void *create_data, H5P_cls_copy_func_t copy, void *copy_data, H5P_cls_close_func_t close,
void *close_data)
/******/
{
int ret_value = -1;
hid_t c_class;
char *c_name;

c_name = (char *)HD5f2cstring(name, (size_t)*name_len);
if (c_name == NULL)
goto DONE;

/*
* Call H5Pcreate_class function.
*/
c_class =
H5Pcreate_class((hid_t)*parent, c_name, create, create_data, copy, copy_data, close, close_data);

if (c_class < 0)
goto DONE;
*cls = (hid_t_f)c_class;
ret_value = 0;

DONE:
if (c_name != NULL)
free(c_name);
return ret_value;
}

/****if* H5Pf/h5pregister_c
* NAME
* h5pregister_c
Expand Down
55 changes: 30 additions & 25 deletions fortran/src/H5Pff.F90
Original file line number Diff line number Diff line change
Expand Up @@ -400,15 +400,16 @@ SUBROUTINE h5pclose_f(prp_id, hdferr)
INTEGER(HID_T), INTENT(IN) :: prp_id
INTEGER, INTENT(OUT) :: hdferr
INTERFACE
INTEGER FUNCTION h5pclose_c(prp_id) &
BIND(C,NAME='h5pclose_c')
INTEGER(C_INT) FUNCTION H5Pclose(prp_id) &
BIND(C,NAME='H5Pclose')
IMPORT :: C_INT
IMPORT :: HID_T
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: prp_id
END FUNCTION h5pclose_c
INTEGER(HID_T), VALUE :: prp_id
END FUNCTION H5Pclose
END INTERFACE

hdferr = h5pclose_c(prp_id)
hdferr = INT(H5Pclose(prp_id))
END SUBROUTINE h5pclose_f

!>
Expand Down Expand Up @@ -5005,31 +5006,32 @@ SUBROUTINE h5pcreate_class_f(parent, name, class, hdferr, create, create_data, &
INTEGER , INTENT(OUT) :: hdferr
TYPE(C_PTR) , OPTIONAL, INTENT(IN) :: create_data, copy_data, close_data
TYPE(C_FUNPTR) , OPTIONAL, INTENT(IN) :: create, copy, close
INTEGER :: name_len
TYPE(C_PTR) :: create_data_default, copy_data_default, close_data_default
TYPE(C_PTR) :: create_data_default, copy_data_default, close_data_default
TYPE(C_FUNPTR) :: create_default, copy_default, close_default

CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name

INTERFACE
INTEGER FUNCTION h5pcreate_class_c(parent, name, name_len, class, &
INTEGER(HID_T) FUNCTION H5Pcreate_class(parent, name, &
create, create_data, copy, copy_data, close, close_data) &
BIND(C, NAME='h5pcreate_class_c')
IMPORT :: c_char, c_ptr, c_funptr
BIND(C, NAME='H5Pcreate_class')
IMPORT :: C_CHAR, C_PTR, C_FUNPTR
IMPORT :: HID_T
INTEGER(HID_T), INTENT(IN) :: parent
CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name
INTEGER, INTENT(IN) :: name_len
INTEGER(HID_T), INTENT(OUT) :: class
TYPE(C_PTR), VALUE :: create_data, copy_data, close_data
TYPE(C_FUNPTR), VALUE :: create, copy, close
END FUNCTION h5pcreate_class_c
INTEGER(HID_T), VALUE :: parent
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name
TYPE(C_PTR), VALUE :: create_data, copy_data, close_data
TYPE(C_FUNPTR), VALUE :: create, copy, close
END FUNCTION H5Pcreate_class
END INTERFACE
name_len = LEN(name)

create_default = c_null_funptr !fix:scot
create_data_default = c_null_ptr
copy_default = c_null_funptr !fix:scot
copy_data_default = c_null_ptr
close_default = c_null_funptr !fix:scot
close_data_default = c_null_ptr
c_name = TRIM(name)//C_NULL_CHAR

create_default = C_NULL_FUNPTR
create_data_default = C_NULL_PTR
copy_default = C_NULL_FUNPTR
copy_data_default = C_NULL_PTR
close_default = C_NULL_FUNPTR
close_data_default = C_NULL_PTR

IF(PRESENT(create)) create_default = create
IF(PRESENT(create_data)) create_data_default = create_data
Expand All @@ -5038,11 +5040,14 @@ END FUNCTION h5pcreate_class_c
IF(PRESENT(close)) close_default = close
IF(PRESENT(close_data)) close_data_default = close_data

hdferr = h5pcreate_class_c(parent, name , name_len, class, &
class = H5Pcreate_class(parent, c_name, &
create_default, create_data_default, &
copy_default, copy_data_default, &
close_default, close_data_default)

hdferr = 0
IF(class.LT.0) hdferr = -1

END SUBROUTINE h5pcreate_class_f

!>
Expand Down
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
4 changes: 0 additions & 4 deletions fortran/src/H5f90proto.h
Original file line number Diff line number Diff line change
Expand Up @@ -368,7 +368,6 @@ H5_FCDLL int_f h5otoken_cmp_c(hid_t_f *loc_id, H5O_token_t *token1, H5O_token_t
* Functions from H5Pf.c
*/
H5_FCDLL int_f h5pcreate_c(hid_t_f *cls, hid_t_f *prp_id);
H5_FCDLL int_f h5pclose_c(hid_t_f *prp_id);
H5_FCDLL int_f h5pcopy_c(hid_t_f *prp_id, hid_t_f *new_prp_id);
H5_FCDLL int_f h5pequal_c(hid_t_f *plist1_id, hid_t_f *plist2_id, int_f *c_flag);
H5_FCDLL int_f h5pget_class_c(hid_t_f *prp_id, hid_t_f *classtype);
Expand Down Expand Up @@ -451,9 +450,6 @@ H5_FCDLL int_f h5pset_small_data_block_size_c(hid_t_f *plist, hsize_t_f *size);
H5_FCDLL int_f h5pget_small_data_block_size_c(hid_t_f *plist, hsize_t_f *size);
H5_FCDLL int_f h5pset_hyper_vector_size_c(hid_t_f *plist, size_t_f *size);
H5_FCDLL int_f h5pget_hyper_vector_size_c(hid_t_f *plist, size_t_f *size);
H5_FCDLL int_f h5pcreate_class_c(hid_t_f *parent, _fcd name, int_f *name_len, hid_t_f *cls,
H5P_cls_create_func_t create, void *create_data, H5P_cls_copy_func_t copy,
void *copy_data, H5P_cls_close_func_t close, void *close_data);
H5_FCDLL int_f h5pregister_c(hid_t_f *cls, _fcd name, int_f *name_len, size_t_f *size, void *value);
H5_FCDLL int_f h5pinsert_c(hid_t_f *plist, _fcd name, int_f *name_len, size_t_f *size, void *value);
H5_FCDLL int_f h5pset_c(hid_t_f *prp_id, _fcd name, int_f *name_len, void *value);
Expand Down
4 changes: 2 additions & 2 deletions fortran/src/hdf5_fortrandll.def.in
Original file line number Diff line number Diff line change
Expand Up @@ -258,7 +258,6 @@ H5P_mp_H5PSET_PRESERVE_F
H5P_mp_H5PGET_PRESERVE_F
H5P_mp_H5PGET_CLASS_F
H5P_mp_H5PCOPY_F
H5P_mp_H5PCLOSE_F
H5P_mp_H5PSET_CHUNK_F
H5P_mp_H5PGET_CHUNK_F
H5P_mp_H5PSET_DEFLATE_F
Expand Down Expand Up @@ -331,7 +330,6 @@ H5P_mp_H5PCOPY_PROP_F
H5P_mp_H5PREMOVE_F
H5P_mp_H5PUNREGISTER_F
H5P_mp_H5PCLOSE_CLASS_F
H5P_mp_H5PCREATE_CLASS_F
H5P_mp_H5PREGISTER_INTEGER
H5P_mp_H5PREGISTER_CHAR
H5P_mp_H5PINSERT_CHAR
Expand Down Expand Up @@ -555,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
Loading

0 comments on commit 6d10906

Please sign in to comment.