summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2023-05-22 23:17:14 (GMT)
committerGitHub <noreply@github.com>2023-05-22 23:17:14 (GMT)
commita888742959249605f83a00f1fd769c15b515969b (patch)
tree4811ce7bac3364f346cc5cac2371d2ce1bd36bf6 /fortran
parent8186a8ded043b383004160ec4ad239687c60d5dd (diff)
downloadhdf5-a888742959249605f83a00f1fd769c15b515969b.zip
hdf5-a888742959249605f83a00f1fd769c15b515969b.tar.gz
hdf5-a888742959249605f83a00f1fd769c15b515969b.tar.bz2
Updated H5Ovisit_f and H5Ovisit_by_name_f wrappers internals. (#2987)
* * Removed C wrappers for H5Ovisit_f and H5Ovist_by_name_f, modifying the Fortran source accordingly. * The intent for op_data was declared INOUT, even though the pointer address INTENT is, in actuality, IN. gfortran was optimizing out op_data in tests where the values were repeatedly reset to the same value. The values were reset in the test because the data the pointer targeted was updated in the callback. * Made use of the 'verify' function to check value correctness. * changed to useing INTEGER(C_INT) instead of C_BOOL, updated the documentation
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Aff.F905
-rw-r--r--fortran/src/H5Lff.F904
-rw-r--r--fortran/src/H5Of.c97
-rw-r--r--fortran/src/H5Off.F9078
-rw-r--r--fortran/src/H5f90proto.h5
-rw-r--r--fortran/test/tH5T_F03.F9030
-rw-r--r--fortran/testpar/async.F9024
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)