misc. fortran fixes for failing CI dailty tests (#3523)

* fixed H5Lvisit* interface

* changed integer type for direct write

fortran/src/H5Fff.F90

@@ -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.
@@ -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
 

fortran/src/H5Lff.F90

@@ -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
 
@@ -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
 
@@ -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
 

fortran/src/H5Off.F90

@@ -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

fortran/src/H5Pff.F90

@@ -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
@@ -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
 
@@ -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) &
@@ -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
 

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

fortran/test/tH5D.F90

@@ -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

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)