From 2345f901b26277f643dd91a528e4da975f4e75c1 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 8 Sep 2023 17:15:52 -0500 Subject: misc. fortran fixes for failing CI dailty tests (#3523) * fixed H5Lvisit* interface * changed integer type for direct write --- fortran/src/H5Fff.F90 | 20 ++++--- fortran/src/H5Lff.F90 | 105 ++++++++++++++++++++++--------------- fortran/src/H5Off.F90 | 2 +- fortran/src/H5Pff.F90 | 16 ++++-- fortran/src/hdf5_fortrandll.def.in | 4 +- fortran/test/tH5D.F90 | 2 +- fortran/test/tH5L_F03.F90 | 11 +++- 7 files changed, 100 insertions(+), 60 deletions(-) diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index e053874..cfae765 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -73,8 +73,8 @@ MODULE H5F !> @brief H5_ih_info_t derived type. TYPE, BIND(C) :: H5_ih_info_t - INTEGER(HSIZE_T) :: heap_size !< Heap size INTEGER(HSIZE_T) :: index_size !< btree and/or list + INTEGER(HSIZE_T) :: heap_size !< Heap size END TYPE H5_ih_info_t !> @brief H5F_info_t_sohm derived type. @@ -1139,20 +1139,24 @@ CONTAINS !! SUBROUTINE H5Fget_info_f(obj_id, file_info, hdferr) IMPLICIT NONE - INTEGER(HID_T) , INTENT(IN) :: obj_id - TYPE(H5F_INFO_T), INTENT(OUT) :: file_info - INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN) :: obj_id + TYPE(H5F_INFO_T), INTENT(OUT), TARGET :: file_info + INTEGER , INTENT(OUT) :: hdferr + + TYPE(C_PTR) :: f_ptr INTERFACE INTEGER(C_INT) FUNCTION H5Fget_info(obj_id, file_info) BIND(C, NAME='H5Fget_info2') - IMPORT :: HID_T, C_INT, H5F_INFO_T + IMPORT :: HID_T, C_PTR, C_INT, H5F_INFO_T IMPLICIT NONE - INTEGER(HID_T) , VALUE :: obj_id - TYPE(H5F_INFO_T), VALUE :: file_info + INTEGER(HID_T), VALUE :: obj_id + TYPE(C_PTR), VALUE :: file_info END FUNCTION H5Fget_info END INTERFACE - hdferr = INT(H5Fget_info(obj_id, file_info)) + f_ptr = C_LOC(file_info) + + hdferr = INT(H5Fget_info(obj_id, f_ptr)) END SUBROUTINE H5Fget_info_f diff --git a/fortran/src/H5Lff.F90 b/fortran/src/H5Lff.F90 index f61af02..bedfb8c 100644 --- a/fortran/src/H5Lff.F90 +++ b/fortran/src/H5Lff.F90 @@ -1514,40 +1514,52 @@ CONTAINS !! !! \brief Recursively visits all links starting from a specified group. !! -!! \param grp_id Group identifier -!! \param idx_type Index type -!! \param order Iteration order -!! \param op Callback function -!! \param op_data User-defined callback function context -!! \param hdferr \fortran_error +!! \param grp_id Group identifier +!! \param idx_type Index type +!! \param order Iteration order +!! \param op Callback function +!! \param op_data User-defined callback function context +!! \param return_value The return value of the first operator that returns non-zero, or zero if +!! all members were processed with no operator returning non-zero. +!! \param hdferr \fortran_error !! !! See C API: @ref H5Lvisit2() !! - SUBROUTINE H5Lvisit_f(grp_id, idx_type, order, op, op_data, hdferr) + SUBROUTINE h5lvisit_f(grp_id, idx_type, order, op, op_data, return_value, hdferr) IMPLICIT NONE - INTEGER(hid_t), INTENT(IN) :: grp_id - INTEGER , INTENT(IN) :: idx_type - INTEGER , INTENT(IN) :: order - TYPE(C_FUNPTR) :: op - TYPE(C_PTR) :: op_data - INTEGER , INTENT(OUT) :: hdferr + INTEGER(hid_t), INTENT(IN) :: grp_id + INTEGER , INTENT(IN) :: idx_type + INTEGER , INTENT(IN) :: order + TYPE(C_FUNPTR), INTENT(IN) :: op + TYPE(C_PTR) , INTENT(INOUT) :: op_data ! Declare INOUT to bypass gfortran 4.8.5 issue + INTEGER , INTENT(OUT) :: return_value + INTEGER , INTENT(OUT) :: hdferr + + INTEGER(C_INT) :: return_value_c INTERFACE INTEGER(C_INT) FUNCTION H5Lvisit(grp_id, idx_type, order, op, op_data) BIND(C, NAME='H5Lvisit2') IMPORT :: c_char, c_int, c_ptr, c_funptr - IMPORT :: HID_T, SIZE_T, HSIZE_T + IMPORT :: HID_T IMPLICIT NONE - INTEGER(hid_t), VALUE :: grp_id - INTEGER , VALUE :: idx_type - INTEGER , VALUE :: order + INTEGER(HID_T), VALUE :: grp_id + INTEGER(C_INT), VALUE :: idx_type + INTEGER(C_INT), VALUE :: order TYPE(C_FUNPTR), VALUE :: op TYPE(C_PTR) , VALUE :: op_data END FUNCTION H5Lvisit END INTERFACE - hdferr = INT(H5Lvisit(grp_id, INT(idx_type, C_INT), INT(order, C_INT), op, op_data)) + return_value_c = INT(H5Lvisit(grp_id, INT(idx_type, C_INT), INT(order, C_INT), op, op_data)) + return_value = INT(return_value_c) + + IF(return_value.GE.0)THEN + hdferr = 0 + ELSE + hdferr = -1 + END IF END SUBROUTINE H5Lvisit_f @@ -1556,47 +1568,51 @@ CONTAINS !! !! \brief Recursively visits all links starting from a specified group. !! -!! \param loc_id Location identifier -!! \param group_name Group name -!! \param idx_type Index type -!! \param order Iteration order -!! \param op Callback function -!! \param op_data User-defined callback function context -!! \param hdferr \fortran_error -!! \param lapl_id Link access property list +!! \param loc_id Location identifier +!! \param group_name Group name +!! \param idx_type Index type +!! \param order Iteration order +!! \param op Callback function +!! \param op_data User-defined callback function context +!! \param return_value The return value of the first operator that returns non-zero, or zero if +!! all members were processed with no operator returning non-zero. +!! \param hdferr \fortran_error +!! \param lapl_id Link access property list !! !! !! See C API: @ref H5Lvisit_by_name2() !! - SUBROUTINE H5Lvisit_by_name_f(loc_id, group_name, idx_type, order, op, op_data, hdferr, lapl_id) + SUBROUTINE H5Lvisit_by_name_f(loc_id, group_name, idx_type, order, op, op_data, return_value, hdferr, lapl_id) IMPLICIT NONE - INTEGER(hid_t), INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: group_name - INTEGER , INTENT(IN) :: idx_type - INTEGER , INTENT(IN) :: order - TYPE(C_FUNPTR) :: op - TYPE(C_PTR) :: op_data - INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER , INTENT(IN) :: idx_type + INTEGER , INTENT(IN) :: order + TYPE(C_FUNPTR) , INTENT(IN) :: op + TYPE(C_PTR) , INTENT(INOUT) :: op_data ! Declare INOUT to bypass gfortran 4.8.5 issue + INTEGER , INTENT(OUT) :: return_value + INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T), INTENT(IN), OPTIONAL :: lapl_id INTEGER(HID_T) :: lapl_id_default CHARACTER(LEN=LEN_TRIM(group_name)+1,KIND=C_CHAR) :: c_name + INTEGER(C_INT) :: return_value_c INTERFACE - INTEGER(C_INT) FUNCTION H5Lvisit_by_name(loc_id, group_name, idx_type, order, op, op_data, lapl_id_default) & + INTEGER(C_INT) FUNCTION H5Lvisit_by_name(loc_id, group_name, idx_type, order, op, op_data, lapl_id) & BIND(C, NAME='H5Lvisit_by_name2') IMPORT :: C_CHAR, C_INT, C_PTR, C_FUNPTR - IMPORT :: HID_T, SIZE_T, HSIZE_T + IMPORT :: HID_T IMPLICIT NONE - INTEGER(hid_t), VALUE :: loc_id + INTEGER(HID_T), VALUE :: loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*) :: group_name - INTEGER , VALUE :: idx_type - INTEGER , VALUE :: order + INTEGER(C_INT), VALUE :: idx_type + INTEGER(C_INT), VALUE :: order TYPE(C_FUNPTR), VALUE :: op TYPE(C_PTR) , VALUE :: op_data - INTEGER(HID_T), VALUE :: lapl_id_default + INTEGER(HID_T), VALUE :: lapl_id END FUNCTION H5Lvisit_by_name END INTERFACE @@ -1605,7 +1621,14 @@ CONTAINS lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = INT(H5Lvisit_by_name(loc_id, c_name, INT(idx_type, C_INT), INT(order, C_INT), op, op_data, lapl_id_default)) + return_value_c = INT(H5Lvisit_by_name(loc_id, c_name, INT(idx_type, C_INT), INT(order, C_INT), op, op_data, lapl_id_default)) + return_value = INT(return_value_c) + + IF(return_value.GE.0)THEN + hdferr = 0 + ELSE + hdferr = -1 + END IF END SUBROUTINE H5Lvisit_by_name_f diff --git a/fortran/src/H5Off.F90 b/fortran/src/H5Off.F90 index 75e0717..4a0a163 100644 --- a/fortran/src/H5Off.F90 +++ b/fortran/src/H5Off.F90 @@ -1345,7 +1345,7 @@ CONTAINS INTEGER(C_INT) FUNCTION H5Ovisit_by_name3(loc_id, object_name, index_type, order, & op, op_data, fields, lapl_id) BIND(C, NAME='H5Ovisit_by_name3') IMPORT :: C_CHAR, C_PTR, C_FUNPTR, C_INT - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T IMPLICIT NONE INTEGER(HID_T), VALUE :: loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*) :: object_name diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index 87da5d5..1b55fe9 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -6363,7 +6363,7 @@ END SUBROUTINE h5pget_virtual_dsetname_f SUBROUTINE H5Pset_file_space_strategy_f(plist_id, strategy, persist, threshold, hdferr) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: plist_id - INTEGER(C_INT) , INTENT(IN) :: strategy + INTEGER , INTENT(IN) :: strategy LOGICAL , INTENT(IN) :: persist INTEGER(HSIZE_T), INTENT(IN) :: threshold INTEGER , INTENT(OUT) :: hdferr @@ -6385,7 +6385,7 @@ END SUBROUTINE h5pget_virtual_dsetname_f ! Transfer value of Fortran LOGICAL to C C_BOOL type c_persist = persist - hdferr = INT( H5Pset_file_space_strategy(plist_id, strategy, c_persist, threshold) ) + hdferr = INT( H5Pset_file_space_strategy(plist_id, INT(strategy, C_INT), c_persist, threshold) ) END SUBROUTINE H5Pset_file_space_strategy_f @@ -6405,12 +6405,13 @@ END SUBROUTINE h5pget_virtual_dsetname_f SUBROUTINE h5pget_file_space_strategy_f(plist_id, strategy, persist, threshold, hdferr) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: plist_id - INTEGER(C_INT) , INTENT(OUT) :: strategy + INTEGER , INTENT(OUT) :: strategy LOGICAL , INTENT(OUT) :: persist INTEGER(HSIZE_T), INTENT(OUT) :: threshold INTEGER , INTENT(OUT) :: hdferr LOGICAL(C_BOOL) :: c_persist + INTEGER(C_INT) :: c_strategy INTERFACE INTEGER(C_INT) FUNCTION H5Pget_file_space_strategy(plist_id, strategy, persist, threshold) & @@ -6424,11 +6425,16 @@ END SUBROUTINE h5pget_virtual_dsetname_f END FUNCTION H5Pget_file_space_strategy END INTERFACE - hdferr = INT( H5Pget_file_space_strategy(plist_id, strategy, c_persist, threshold) ) + + hdferr = INT( H5Pget_file_space_strategy(plist_id, c_strategy, c_persist, threshold) ) ! Transfer value of Fortran LOGICAL and C C_BOOL type persist = .FALSE. - IF(hdferr .GE. 0) persist = c_persist + strategy = -1 + IF(hdferr .GE. 0)THEN + persist = c_persist + strategy = INT(c_strategy) + ENDIF END SUBROUTINE h5pget_file_space_strategy_f diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index e6bb95a..3b6600c 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -224,8 +224,8 @@ H5L_mp_H5LGET_NAME_BY_IDX_F H5L_mp_H5LITERATE_F H5L_mp_H5LITERATE_ASYNC_F H5L_mp_H5LITERATE_BY_NAME_F -H5L_mp_H5VISIT_F -H5L_mp_H5VISIT_BY_NAME_F +H5L_mp_H5LVISIT_F +H5L_mp_H5LVISIT_BY_NAME_F ; H5O H5O_mp_H5OCLOSE_F diff --git a/fortran/test/tH5D.F90 b/fortran/test/tH5D.F90 index 4005c78..328141d 100644 --- a/fortran/test/tH5D.F90 +++ b/fortran/test/tH5D.F90 @@ -1021,7 +1021,7 @@ CONTAINS INTEGER(SIZE_T), PARAMETER :: CHUNK1 = DIM1/2 INTEGER(HSIZE_T), DIMENSION(2) :: offset INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/DIM0,DIM1/) - INTEGER(C_INT), DIMENSION(CHUNK0,CHUNK1), TARGET :: wdata1, rdata1, wdata2, rdata2 + INTEGER, DIMENSION(CHUNK0,CHUNK1), TARGET :: wdata1, rdata1, wdata2, rdata2 INTEGER(HSIZE_T), DIMENSION(2) :: chunk = (/CHUNK0, CHUNK1/) INTEGER :: i, j, n INTEGER :: error diff --git a/fortran/test/tH5L_F03.F90 b/fortran/test/tH5L_F03.F90 index 426e005..b3fa80e 100644 --- a/fortran/test/tH5L_F03.F90 +++ b/fortran/test/tH5L_F03.F90 @@ -425,6 +425,7 @@ SUBROUTINE test_visit(cleanup, total_error) CHARACTER(LEN=MAX_CHAR_LEN) :: tmp INTEGER :: error INTEGER :: istart, iend, i, j + INTEGER :: ret_val obj_list(1) = "Dataset_zero" obj_list(2) = "Group1" @@ -519,8 +520,11 @@ SUBROUTINE test_visit(cleanup, total_error) udata%n_obj = 0 udata%name(:) = " " - CALL h5lvisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, error) + CALL h5lvisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, ret_val, error) CALL check("h5lvisit_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5lvisit_f", -1, total_error) + ENDIF IF(udata%n_obj.NE.11)THEN CALL check("h5lvisit_f: Wrong number of objects visited", -1, total_error) @@ -545,8 +549,11 @@ SUBROUTINE test_visit(cleanup, total_error) udata%n_obj = 0 udata%name(:) = " " - CALL h5lvisit_by_name_f(fid, "/", H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, error) + CALL h5lvisit_by_name_f(fid, "/", H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, ret_val, error) CALL check("h5lvisit_by_name_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_f", -1, total_error) + ENDIF IF(udata%n_obj.NE.11)THEN CALL check("h5lvisit_by_name_f: Wrong number of objects visited", -1, total_error) -- cgit v0.12