diff options
Diffstat (limited to 'fortran')
| -rw-r--r-- | fortran/src/H5Aff.F90 | 5 | ||||
| -rw-r--r-- | fortran/src/H5Lff.F90 | 4 | ||||
| -rw-r--r-- | fortran/src/H5Of.c | 97 | ||||
| -rw-r--r-- | fortran/src/H5Off.F90 | 78 | ||||
| -rw-r--r-- | fortran/src/H5f90proto.h | 5 | ||||
| -rw-r--r-- | fortran/test/tH5T_F03.F90 | 30 | ||||
| -rw-r--r-- | fortran/testpar/async.F90 | 24 |
7 files changed, 72 insertions, 171 deletions
diff --git a/fortran/src/H5Aff.F90 b/fortran/src/H5Aff.F90 index 8159731..23bfaea 100644 --- a/fortran/src/H5Aff.F90 +++ b/fortran/src/H5Aff.F90 @@ -238,7 +238,6 @@ CONTAINS TYPE(C_PTR) :: file_default = C_NULL_PTR TYPE(C_PTR) :: func_default = C_NULL_PTR INTEGER(KIND=C_INT) :: line_default = 0 - CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name INTERFACE @@ -1644,7 +1643,9 @@ CONTAINS !! !! \param obj_id Object identifier !! \param attr_name Attribute name -!! \param attr_exists Pointer to attribute exists status, must be of type LOGICAL(C_BOOL) and initialize to .FALSE. +!! \param attr_exists Pointer to attribute exists status. It should be declared INTEGER(C_INT) and initialized +!! to zero (false) for portability. It will return one when true. LOGICAL(C_BOOL) is also +!! acceptable but may encounter atypical anomalies. It should be initialized to false when used. !! \param es_id \es_id !! \param hdferr \fortran_error !! \param file \fortran_file diff --git a/fortran/src/H5Lff.F90 b/fortran/src/H5Lff.F90 index 790a65d..2340ce4 100644 --- a/fortran/src/H5Lff.F90 +++ b/fortran/src/H5Lff.F90 @@ -765,7 +765,9 @@ CONTAINS !! !! \param loc_id Identifier of the file or group to query. !! \param name Link name to check. -!! \param link_exists Pointer to Link exists status, must be of type LOGICAL(C_BOOL) and initialize to .FALSE. +!! \param link_exists Pointer to link exists status. It should be declared INTEGER(C_INT) and initialized +!! to zero (false) for portability. It will return one when true. LOGICAL(C_BOOL) is also +!! acceptable but may encounter atypical anomalies. It should be initialized to false when used. !! \param es_id \es_id !! \param hdferr \fortran_error !! \param lapl_id Link access property list identifier. diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c index 186a9a2..54e5187 100644 --- a/fortran/src/H5Of.c +++ b/fortran/src/H5Of.c @@ -132,50 +132,6 @@ done: return ret_value; } -/****if* H5Of/h5ovisit_c - * NAME - * h5ovisit_c - * PURPOSE - * Calls H5Ovisit - * INPUTS - * object_id - Identifier specifying subject group - * index_type - Type of index which determines the order - * order - Order within index - * idx - Iteration position at which to start - * op - Callback function passing data regarding the link to the calling application - * op_data - User-defined pointer to data required by the application for its processing of the link - * fields - Flags specifying the fields to include in object_info. - * - * OUTPUTS - * idx - Position at which an interrupted iteration may be restarted - * - * RETURNS - * >0 on success, 0< on failure - * AUTHOR - * M. Scot Breitenfeld - * November 19, 2008 - * SOURCE - */ -int_f -h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate2_t op, void *op_data, - int_f *fields) -/******/ -{ - int_f ret_value = -1; /* Return value */ - herr_t func_ret_value; /* H5Linterate return value */ - - /* - * Call H5Ovisit - */ - - func_ret_value = H5Ovisit3((hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, op, - op_data, (unsigned)*fields); - - ret_value = (int_f)func_ret_value; - - return ret_value; -} - /****if* H5Of/h5oopen_by_token_c * NAME * h5oopen_by_token_c @@ -358,59 +314,6 @@ done: return ret_value; } -/****if* H5Of/h5ovisit_by_name_c - * NAME - * h5ovisit_by_name_c - * PURPOSE - * Calls H5Ovisit_by_name - * INPUTS - * object_id - Identifier specifying subject group. - * index_type - Type of index which determines the order. - * order - Order within index. - * idx - Iteration position at which to start. - * op - Callback function passing data regarding the link to the calling application. - * op_data - User-defined pointer to data required by the application for its processing of the link. - * fields - Flags specifying the fields to include in object_info. - * - * OUTPUTS - * idx - Position at which an interrupted iteration may be restarted. - * - * RETURNS - * >0 on success, 0< on failure - * AUTHOR - * M. Scot Breitenfeld - * May 16, 2012 - * SOURCE - */ -int_f -h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order, - H5O_iterate2_t op, void *op_data, hid_t_f *lapl_id, int_f *fields) -/******/ -{ - int_f ret_value = -1; /* Return value */ - herr_t func_ret_value; /* H5Linterate return value */ - char *c_object_name = NULL; /* Buffer to hold C string */ - - /* - * Convert FORTRAN name to C name - */ - if ((c_object_name = HD5f2cstring(object_name, (size_t)*namelen)) == NULL) - HGOTO_DONE(FAIL); - - /* - * Call H5Ovisit_by_name - */ - func_ret_value = - H5Ovisit_by_name3((hid_t)*loc_id, c_object_name, (H5_index_t)*index_type, (H5_iter_order_t)*order, op, - op_data, (unsigned)*fields, (hid_t)*lapl_id); - ret_value = (int_f)func_ret_value; - -done: - if (c_object_name) - HDfree(c_object_name); - return ret_value; -} - /****if* H5Of/h5odecr_refcount_c * NAME * h5odecr_refcount_c diff --git a/fortran/src/H5Off.F90 b/fortran/src/H5Off.F90 index 84a1590..d0bb459 100644 --- a/fortran/src/H5Off.F90 +++ b/fortran/src/H5Off.F90 @@ -1025,33 +1025,35 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: object_id INTEGER, INTENT(IN) :: index_type INTEGER, INTENT(IN) :: order - TYPE(C_FUNPTR), INTENT(IN) :: op - TYPE(C_PTR), INTENT(IN) :: op_data + 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, INTENT(IN), OPTIONAL :: fields - INTEGER :: fields_c + INTEGER, INTENT(IN), OPTIONAL :: fields + + INTEGER(C_INT) :: fields_c + INTEGER(C_INT) :: return_value_c INTERFACE - INTEGER FUNCTION h5ovisit_c(object_id, index_type, order, op, op_data, fields) & - BIND(C, NAME='h5ovisit_c') - IMPORT :: C_FUNPTR, C_PTR + INTEGER(C_INT) FUNCTION H5Ovisit3(object_id, index_type, order, op, op_data, fields) & + BIND(C, NAME='H5Ovisit3') + IMPORT :: C_FUNPTR, C_PTR, C_INT IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T):: object_id - INTEGER :: index_type - INTEGER :: order + INTEGER(HID_T), VALUE :: object_id + INTEGER(C_INT), VALUE :: index_type + INTEGER(C_INT), VALUE :: order TYPE(C_FUNPTR), VALUE :: op - TYPE(C_PTR), VALUE :: op_data - INTEGER :: fields - END FUNCTION h5ovisit_c + TYPE(C_PTR) , VALUE :: op_data + INTEGER(C_INT), VALUE :: fields + END FUNCTION H5Ovisit3 END INTERFACE - fields_c = H5O_INFO_ALL_F - IF(PRESENT(fields)) fields_c = fields + fields_c = INT(H5O_INFO_ALL_F,C_INT) + IF(PRESENT(fields)) fields_c = INT(fields,C_INT) - return_value = h5ovisit_c(object_id, index_type, order, op, op_data, fields_c) + return_value_c = H5Ovisit3(object_id, INT(index_type,C_INT), INT(order, C_INT), op, op_data, fields_c) + return_value = INT(return_value_c) IF(return_value.GE.0)THEN hdferr = 0 @@ -1327,44 +1329,44 @@ CONTAINS INTEGER , INTENT(IN) :: order TYPE(C_FUNPTR) , INTENT(IN) :: op - TYPE(C_PTR) , INTENT(IN) :: op_data + 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 , INTENT(IN) , OPTIONAL :: fields - INTEGER(SIZE_T) :: namelen - INTEGER(HID_T) :: lapl_id_default - INTEGER :: fields_c + INTEGER(HID_T) :: lapl_id_c + INTEGER(C_INT) :: fields_c + INTEGER(C_INT) :: return_value_c + CHARACTER(LEN=LEN_TRIM(object_name)+1,KIND=C_CHAR) :: object_name_c INTERFACE - INTEGER FUNCTION h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, & - op, op_data, lapl_id, fields) BIND(C, NAME='h5ovisit_by_name_c') - IMPORT :: C_CHAR, C_PTR, C_FUNPTR + 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 IMPLICIT NONE - INTEGER(HID_T) :: loc_id + INTEGER(HID_T), VALUE :: loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*) :: object_name - INTEGER(SIZE_T) :: namelen - INTEGER :: index_type - INTEGER :: order + INTEGER(C_INT), VALUE :: index_type + INTEGER(C_INT), VALUE :: order TYPE(C_FUNPTR), VALUE :: op TYPE(C_PTR) , VALUE :: op_data - INTEGER(HID_T) :: lapl_id - INTEGER :: fields - END FUNCTION h5ovisit_by_name_c + INTEGER(C_INT), VALUE :: fields + INTEGER(HID_T), VALUE :: lapl_id + END FUNCTION H5Ovisit_by_name3 END INTERFACE - fields_c = H5O_INFO_ALL_F - IF(PRESENT(fields)) fields_c = fields - - namelen = LEN(object_name) + fields_c = INT(H5O_INFO_ALL_F, C_INT) + IF(PRESENT(fields)) fields_c = INT(fields, C_INT) + object_name_c = TRIM(object_name)//C_NULL_CHAR - lapl_id_default = H5P_DEFAULT_F - IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + lapl_id_c = INT(H5P_DEFAULT_F, C_INT) + IF(PRESENT(lapl_id)) lapl_id_c = INT(lapl_id, C_INT) - return_value = h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, & - op, op_data, lapl_id_default, fields_c) + return_value_c = H5Ovisit_by_name3(loc_id, object_name_c, INT(index_type, C_INT), INT(order, C_INT), & + op, op_data, fields_c, lapl_id_c) + return_value = INT(return_value_c) IF(return_value.GE.0)THEN hdferr = 0 diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 11addfa..9085ae5 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -344,11 +344,6 @@ H5_FCDLL int_f h5oclose_c(hid_t_f *object_id); H5_FCDLL int_f h5oopen_by_token_c(hid_t_f *loc_id, H5O_token_t *token, hid_t_f *obj_id); H5_FCDLL int_f h5olink_c(hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id); -H5_FCDLL int_f h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate2_t op, - void *op_data, int_f *fields); -H5_FCDLL int_f h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, - int_f *order, H5O_iterate2_t op, void *op_data, hid_t_f *lapl_id, - int_f *fields); H5_FCDLL int_f h5oget_info_c(hid_t_f *object_id, H5O_info_t_f *object_info, int_f *fields); H5_FCDLL int_f h5oget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info, diff --git a/fortran/test/tH5T_F03.F90 b/fortran/test/tH5T_F03.F90 index 86e49b6..0f56806 100644 --- a/fortran/test/tH5T_F03.F90 +++ b/fortran/test/tH5T_F03.F90 @@ -3598,32 +3598,26 @@ SUBROUTINE multiple_dset_rw(total_error) CALL check("h5dread_multi_f", error, total_error) ! check the written and read in values + error = 0 DO i = 1, rdim - IF(rbuf_real(i).NE.wbuf_real(i))THEN - total_error = total_error + 1 - END IF + CALL VERIFY("h5dread_multi_f",rbuf_real(i), wbuf_real(i), error) END DO + total_error = total_error + error DO i = 1, idim - IF(rbuf_int(i).NE.wbuf_int(i))THEN - total_error = total_error + 1 - END IF + CALL VERIFY("h5dread_multi_f",rbuf_int(i),wbuf_int(i), error) END DO + total_error = total_error + error DO i = 1, cdim - IF(rbuf_chr(i).NE.wbuf_chr(i))THEN - total_error = total_error + 1 - END IF + CALL VERIFY("h5dread_multi_f",rbuf_chr(i),wbuf_chr(i), error) END DO + total_error = total_error + error + error = 0 DO i = 1, ddim - IF(rbuf_derived(i)%r.NE.wbuf_derived(i)%r)THEN - total_error = total_error + 1 - END IF - IF(rbuf_derived(i)%i.NE.wbuf_derived(i)%i)THEN - total_error = total_error + 1 - END IF - IF(rbuf_derived(i)%c.NE.wbuf_derived(i)%c)THEN - total_error = total_error + 1 - END IF + CALL VERIFY("h5dread_multi_f",rbuf_derived(i)%r,wbuf_derived(i)%r,error) + CALL VERIFY("h5dread_multi_f",rbuf_derived(i)%i,wbuf_derived(i)%i,error) + CALL VERIFY("h5dread_multi_f",rbuf_derived(i)%c,wbuf_derived(i)%c,error) END DO + total_error = total_error + error DO i = 1, idim DO j = 1, idim2 DO k = 1, idim3 diff --git a/fortran/testpar/async.F90 b/fortran/testpar/async.F90 index e3a80ad..83cd41c 100644 --- a/fortran/testpar/async.F90 +++ b/fortran/testpar/async.F90 @@ -26,6 +26,10 @@ MODULE test_async_APIs LOGICAL :: async_enabled = .TRUE. LOGICAL :: mpi_thread_mult = .TRUE. + INTEGER(C_INT), PARAMETER :: logical_true = 1 + INTEGER(C_INT), PARAMETER :: logical_false = 0 + + ! Custom group iteration callback data TYPE, bind(c) :: iter_info CHARACTER(KIND=C_CHAR), DIMENSION(1:12) :: name ! The name of the object @@ -174,7 +178,7 @@ CONTAINS INTEGER(HID_T) :: space_id INTEGER(HID_T) :: attr_id0, attr_id1, attr_id2 LOGICAL :: exists - LOGICAL(C_BOOL), TARGET :: exists0 = .FALSE., exists1 = .FALSE., exists2 = .FALSE., exists3 = .FALSE. + INTEGER(C_INT), TARGET :: exists0=logical_false, exists1=logical_false, exists2=logical_false, exists3=logical_false TYPE(C_PTR) :: f_ptr, f_ptr1, f_ptr2 CALL H5EScreate_f(es_id, hdferror) @@ -300,10 +304,10 @@ CONTAINS CALL check("H5ESwait_f", hdferror, total_error) CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) - CALL VERIFY("H5Aexists_async_f", LOGICAL(exists0), .TRUE., total_error) - CALL VERIFY("H5Aexists_async_f", LOGICAL(exists1), .TRUE., total_error) - CALL VERIFY("H5Aexists_by_name_async_f", LOGICAL(exists2), .TRUE., total_error) - CALL VERIFY("H5Aexists_by_name_async_f", LOGICAL(exists3), .TRUE., total_error) + CALL VERIFY("H5Aexists_async_f", exists0, logical_true, total_error) + CALL VERIFY("H5Aexists_async_f", exists1, logical_true, total_error) + CALL VERIFY("H5Aexists_by_name_async_f", exists2, logical_true, total_error) + CALL VERIFY("H5Aexists_by_name_async_f", exists3, logical_true, total_error) CALL VERIFY("H5Aread_async_f", attr_rdata0, attr_data0, total_error) CALL VERIFY("H5Aread_async_f", attr_rdata1, attr_data1, total_error) @@ -784,7 +788,7 @@ CONTAINS INTEGER(hid_t) :: sid = -1 ! Dataspace ID CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group" CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME2 = "corder_grp00" - LOGICAL(C_BOOL), TARGET :: exists1, exists2 + INTEGER(C_INT), TARGET :: exists1, exists2 LOGICAL :: exists TYPE(C_PTR) :: f_ptr @@ -911,12 +915,12 @@ CONTAINS CALL H5Fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) CALL check("h5fopen_async_f",hdferror,total_error) - exists1 = .FALSE. + exists1 = logical_false f_ptr = C_LOC(exists1) CALL H5Lexists_async_f(file_id, "hard_zero", f_ptr, es_id, hdferror) CALL check("H5Lexists_async_f",hdferror,total_error) - exists2 = .FALSE. + exists2 = logical_false f_ptr = C_LOC(exists2) CALL H5Lexists_async_f(file_id, "hard_two", f_ptr, es_id, hdferror) CALL check("H5Lexists_async_f",hdferror,total_error) @@ -931,8 +935,8 @@ CONTAINS CALL check("H5ESwait_f", hdferror, total_error) CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) - CALL VERIFY("H5Lexists_async_f", LOGICAL(exists1), .TRUE., total_error) - CALL VERIFY("H5Lexists_async_f", LOGICAL(exists2), .TRUE., total_error) + CALL VERIFY("H5Lexists_async_f", exists1, logical_true, total_error) + CALL VERIFY("H5Lexists_async_f", exists2, logical_true, total_error) CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id ) CALL check("h5fopen_f",hdferror, total_error) |