Skip to content

misc. fortran fixes for failing CI dailty tests #3523

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 6 commits into from
Sep 8, 2023
Merged

misc. fortran fixes for failing CI dailty tests #3523

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
404087c
misc. fortran fixes for CI testing
brtnfld Sep 8, 2023
b170a99
misc. fixes
brtnfld Sep 8, 2023
b46f166
fixed DLL
brtnfld Sep 8, 2023
15808c9
fixed DLL
brtnfld Sep 8, 2023
0be99e4
fixed H5Lvisit* interface
brtnfld Sep 8, 2023
778c6cc
changed integer type for direct write
brtnfld Sep 8, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 12 additions & 8 deletions fortran/src/H5Fff.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -73,8 +73,8 @@ END FUNCTION h5fis_accessible

!> @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.
Expand Down Expand Up @@ -1139,20 +1139,24 @@ END SUBROUTINE h5fset_dset_no_attrs_hint_f
!!
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

Expand Down
105 changes: 64 additions & 41 deletions fortran/src/H5Lff.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1514,40 +1514,52 @@ END SUBROUTINE h5literate_by_name_f
!!
!! \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

Expand All @@ -1556,47 +1568,51 @@ END SUBROUTINE H5Lvisit_f
!!
!! \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

Expand All @@ -1605,7 +1621,14 @@ END FUNCTION H5Lvisit_by_name
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

Expand Down
2 changes: 1 addition & 1 deletion fortran/src/H5Off.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1345,7 +1345,7 @@ SUBROUTINE h5ovisit_by_name_f(loc_id, object_name, index_type, order, op, op_dat
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
Expand Down
16 changes: 11 additions & 5 deletions fortran/src/H5Pff.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6363,7 +6363,7 @@ END SUBROUTINE h5pget_no_selection_io_cause_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
Expand All @@ -6385,7 +6385,7 @@ END FUNCTION H5Pset_file_space_strategy
! 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

Expand All @@ -6405,12 +6405,13 @@ END SUBROUTINE H5Pset_file_space_strategy_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) &
Expand All @@ -6424,11 +6425,16 @@ INTEGER(C_INT) FUNCTION H5Pget_file_space_strategy(plist_id, strategy, persist,
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

Expand Down
4 changes: 2 additions & 2 deletions fortran/src/hdf5_fortrandll.def.in
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion fortran/test/tH5D.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1021,7 +1021,7 @@ SUBROUTINE test_direct_chunk_io(cleanup, total_error)
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
Expand Down
11 changes: 9 additions & 2 deletions fortran/test/tH5L_F03.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down