summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorM. Scot Breitenfeld <brtnfld@hdfgroup.org>2018-12-12 21:39:18 (GMT)
committerM. Scot Breitenfeld <brtnfld@hdfgroup.org>2019-01-10 23:10:05 (GMT)
commit6e489435e9ca484a4927d3bb83f2c0058147d7ba (patch)
tree8aab3b95bda0cee3ffdd4fa0ea018172fb074fe7 /fortran
parenta043211d9edf2df3ea8049bda4be6bdcbf0970e9 (diff)
downloadhdf5-6e489435e9ca484a4927d3bb83f2c0058147d7ba.zip
hdf5-6e489435e9ca484a4927d3bb83f2c0058147d7ba.tar.gz
hdf5-6e489435e9ca484a4927d3bb83f2c0058147d7ba.tar.bz2
merged:
HDFFV-10652 HDFFV-10443
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Of.c48
-rw-r--r--fortran/src/H5Off.F90107
-rw-r--r--fortran/src/H5_f.c11
-rw-r--r--fortran/src/H5_ff.F9074
-rw-r--r--fortran/src/H5f90global.F9013
-rw-r--r--fortran/src/H5f90proto.h10
-rw-r--r--fortran/src/H5match_types.c13
-rw-r--r--fortran/src/hdf5_fortrandll.def.in1
-rw-r--r--fortran/test/tH5O_F03.F90390
9 files changed, 598 insertions, 69 deletions
diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c
index 45b7f09..08305ea 100644
--- a/fortran/src/H5Of.c
+++ b/fortran/src/H5Of.c
@@ -27,11 +27,15 @@ fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info);
int_f
fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) {
+ /* This function does not used the field parameter because we want
+ * this function to fill the unfilled fields with C's default values.
+ */
+
struct tm *ts;
object_info->fileno = Oinfo.fileno;
object_info->addr = (haddr_t_f)Oinfo.addr;
-
+
object_info->type = (int_f)Oinfo.type;
object_info->rc = (int_f)Oinfo.rc;
@@ -96,6 +100,8 @@ fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) {
object_info->meta_size.obj.index_size = (hsize_t_f)Oinfo.meta_size.obj.index_size;
object_info->meta_size.obj.heap_size = (hsize_t_f)Oinfo.meta_size.obj.heap_size;
+ object_info->meta_size.attr.index_size = (hsize_t_f)Oinfo.meta_size.attr.index_size;
+ object_info->meta_size.attr.heap_size = (hsize_t_f)Oinfo.meta_size.attr.heap_size;
return 0;
@@ -138,7 +144,7 @@ h5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen
* Call H5Olink function.
*/
if((hid_t_f)H5Olink((hid_t)*object_id, (hid_t)*new_loc_id, c_name,
- (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0)
+ (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0)
HGOTO_DONE(FAIL);
done:
@@ -229,6 +235,7 @@ h5oclose_c ( hid_t_f *object_id )
* 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
@@ -241,7 +248,7 @@ h5oclose_c ( hid_t_f *object_id )
* SOURCE
*/
int_f
-h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data )
+h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data, int_f *fields )
/******/
{
int_f ret_value = -1; /* Return value */
@@ -250,7 +257,8 @@ h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op,
/*
* Call H5Ovisit2
*/
- func_ret_value = H5Ovisit2( (hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, op, op_data, H5O_INFO_ALL);
+
+ func_ret_value = H5Ovisit2( (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;
@@ -302,6 +310,7 @@ h5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id)
* name - Name of group, relative to loc_id.
* namelen - Name length.
* lapl_id - Link access property list.
+ * fields - Flags specifying the fields to include in object_info.
* OUTPUTS
* object_info - Buffer in which to return object information.
*
@@ -314,7 +323,7 @@ h5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id)
*/
int_f
h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id,
- H5O_info_t_f *object_info)
+ H5O_info_t_f *object_info, int_f *fields)
/******/
{
char *c_name = NULL; /* Buffer to hold C string */
@@ -331,10 +340,10 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l
* Call H5Oinfo_by_name function.
*/
if(H5Oget_info_by_name2((hid_t)*loc_id, c_name,
- &Oinfo, H5O_INFO_ALL, (hid_t)*lapl_id) < 0)
+ &Oinfo, (unsigned)*fields, (hid_t)*lapl_id) < 0)
HGOTO_DONE(FAIL);
- ret_value = fill_h5o_info_t_f(Oinfo,object_info);
+ ret_value = fill_h5o_info_t_f(Oinfo, object_info);
done:
if(c_name)
@@ -354,6 +363,7 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l
* lapl_id - Link access property list.
* OUTPUTS
* object_info - Buffer in which to return object information.
+ * fields - Flags specifying the fields to include in object_info.
*
* RETURNS
* 0 on success, -1 on failure
@@ -364,7 +374,7 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l
*/
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)
+ int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info, int_f *fields)
/******/
{
char *c_group_name = NULL; /* Buffer to hold C string */
@@ -386,7 +396,7 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen,
* Call H5Oinfo_by_idx function.
*/
if(H5Oget_info_by_idx2((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n,
- &Oinfo, H5O_INFO_ALL, (hid_t)*lapl_id) < 0)
+ &Oinfo, (unsigned)*fields, (hid_t)*lapl_id) < 0)
HGOTO_DONE(FAIL);
ret_value = fill_h5o_info_t_f(Oinfo,object_info);
@@ -404,6 +414,7 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen,
* Calls H5Oget_info
* INPUTS
* object_id - Identifier for target object.
+ * fields - Flags specifying the fields to include in object_info.
* OUTPUTS
* object_info - Buffer in which to return object information.
*
@@ -415,7 +426,7 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen,
* SOURCE
*/
int_f
-h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info)
+h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info, int_f *fields)
/******/
{
int_f ret_value = 0; /* Return value */
@@ -424,7 +435,7 @@ h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info)
/*
* Call H5Oinfo_by_name function.
*/
- if(H5Oget_info2((hid_t)*object_id, &Oinfo, H5O_INFO_ALL) < 0)
+ if(H5Oget_info2((hid_t)*object_id, &Oinfo, (unsigned)*fields) < 0)
HGOTO_DONE(FAIL);
ret_value = fill_h5o_info_t_f(Oinfo,object_info);
@@ -457,8 +468,8 @@ h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info)
*/
int_f
h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
- hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len,
- hid_t_f *ocpypl_id, hid_t_f *lcpl_id )
+ hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len,
+ hid_t_f *ocpypl_id, hid_t_f *lcpl_id )
/******/
{
char *c_src_name = NULL; /* Buffer to hold C string */
@@ -478,7 +489,7 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
* Call H5Ocopy function.
*/
if(H5Ocopy( (hid_t)*src_loc_id, c_src_name, (hid_t)*dst_loc_id, c_dst_name,
- (hid_t)*ocpypl_id, (hid_t)*lcpl_id) < 0)
+ (hid_t)*ocpypl_id, (hid_t)*lcpl_id) < 0)
HGOTO_DONE(FAIL);
done:
@@ -503,6 +514,7 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
* 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
@@ -516,7 +528,7 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
*/
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_iterate_t op, void *op_data, hid_t_f *lapl_id )
+ H5O_iterate_t op, void *op_data, hid_t_f *lapl_id, int_f *fields )
/******/
{
int_f ret_value = -1; /* Return value */
@@ -533,7 +545,7 @@ h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f
* Call H5Ovisit
*/
func_ret_value = H5Ovisit_by_name2( (hid_t)*loc_id, c_object_name, (H5_index_t)*index_type, (H5_iter_order_t)*order,
- op, op_data, H5O_INFO_ALL, (hid_t)*lapl_id);
+ op, op_data, (unsigned)*fields, (hid_t)*lapl_id);
ret_value = (int_f)func_ret_value;
done:
@@ -763,7 +775,7 @@ h5oset_comment_by_name_c (hid_t_f *object_id, _fcd name, size_t_f *namelen, _fc
*/
int_f
h5oopen_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen,
- int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id)
+ int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id)
/******/
{
char *c_group_name = NULL; /* Buffer to hold C string */
@@ -868,7 +880,7 @@ h5oget_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssi
*/
int_f
h5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size,
- _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id)
+ _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id)
/******/
{
char *c_comment = NULL; /* Buffer to hold C string */
diff --git a/fortran/src/H5Off.F90 b/fortran/src/H5Off.F90
index 243ec29..8c77230 100644
--- a/fortran/src/H5Off.F90
+++ b/fortran/src/H5Off.F90
@@ -69,6 +69,15 @@ MODULE H5O
TYPE(mesg_t) :: mesg
END TYPE hdr_t
+ TYPE, BIND(C) :: c_hdr_t
+ INTEGER(C_INT) :: version ! Version number of header format in file
+ INTEGER(C_INT) :: nmesgs ! Number of object header messages
+ INTEGER(C_INT) :: nchunks ! Number of object header chunks
+ INTEGER(C_INT) :: flags ! Object header status flags
+ TYPE(space_t) :: space
+ TYPE(mesg_t) :: mesg
+ END TYPE c_hdr_t
+
! Extra metadata storage for obj & attributes
TYPE, BIND(C) :: H5_ih_info_t
INTEGER(hsize_t) :: index_size ! btree and/or list
@@ -83,7 +92,7 @@ MODULE H5O
TYPE, BIND(C) :: h5o_info_t
INTEGER(C_LONG) :: fileno ! File number that object is located in
INTEGER(haddr_t) :: addr ! Object address in file
- INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.)
+ INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.)
INTEGER :: rc ! Reference count of object
INTEGER, DIMENSION(8) :: atime ! Access time ! -- NOTE --
@@ -98,6 +107,28 @@ MODULE H5O
TYPE(meta_size_t) :: meta_size
END TYPE h5o_info_t
+! C interoperable structure for h5o_info_t. The Fortran derived type returns the time
+! values as an integer array as specified in the Fortran intrinsic DATE_AND_TIME(VALUES).
+! Whereas, this derived type does not.
+
+ TYPE, BIND(C) :: c_h5o_info_t
+ INTEGER(C_LONG) :: fileno ! File number that object is located in
+ INTEGER(haddr_t) :: addr ! Object address in file
+ INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.)
+ INTEGER(C_INT) :: rc ! Reference count of object
+
+ INTEGER(KIND=TIME_T) :: atime ! Access time
+ INTEGER(KIND=TIME_T) :: mtime ! modify time
+ INTEGER(KIND=TIME_T) :: ctime ! create time
+ INTEGER(KIND=TIME_T) :: btime ! Access time
+
+ INTEGER(hsize_t) :: num_attrs ! # of attributes attached to object
+
+ TYPE(c_hdr_t) :: hdr
+
+ TYPE(meta_size_t) :: meta_size
+ END TYPE c_h5o_info_t
+
!*****
CONTAINS
@@ -834,12 +865,16 @@ CONTAINS
! return_value - returns the return value of the first operator that returns a positive value, or
! zero if all members were processed with no operator returning non-zero.
! hdferr - Returns 0 if successful and -1 if fails
+!
+! Optional parameters:
+! fields - Flags specifying the fields to include in object_info.
+!
! AUTHOR
! M. Scot Breitenfeld
! November 19, 2008
!
! Fortran2003 Interface:
- SUBROUTINE h5ovisit_f(object_id, index_type, order, op, op_data, return_value, hdferr)
+ SUBROUTINE h5ovisit_f(object_id, index_type, order, op, op_data, return_value, hdferr, fields)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: object_id
INTEGER, INTENT(IN) :: index_type
@@ -849,10 +884,12 @@ CONTAINS
TYPE(C_PTR) :: op_data
INTEGER, INTENT(OUT) :: return_value
INTEGER, INTENT(OUT) :: hdferr
+ INTEGER, INTENT(IN), OPTIONAL :: fields
!*****
+ INTEGER :: fields_c
INTERFACE
- INTEGER FUNCTION h5ovisit_c(object_id, index_type, order, op, op_data) &
+ INTEGER FUNCTION h5ovisit_c(object_id, index_type, order, op, op_data, fields) &
BIND(C, NAME='h5ovisit_c')
IMPORT :: C_FUNPTR, C_PTR
IMPORT :: HID_T
@@ -862,10 +899,14 @@ CONTAINS
INTEGER, INTENT(IN) :: order
TYPE(C_FUNPTR), VALUE :: op
TYPE(C_PTR), VALUE :: op_data
+ INTEGER, INTENT(IN) :: fields
END FUNCTION h5ovisit_c
END INTERFACE
- return_value = h5ovisit_c(object_id, index_type, order, op, op_data)
+ fields_c = H5O_INFO_ALL_F
+ IF(PRESENT(fields)) fields_c = fields
+
+ return_value = h5ovisit_c(object_id, index_type, order, op, op_data, fields_c)
IF(return_value.GE.0)THEN
hdferr = 0
@@ -894,26 +935,29 @@ CONTAINS
!
! Optional parameters:
! lapl_id - Link access property list.
+! fields - Flags specifying the fields to include in object_info.
!
! AUTHOR
! M. Scot Breitenfeld
! December 1, 2008
!
! Fortran2003 Interface:
- SUBROUTINE h5oget_info_by_name_f(loc_id, name, object_info, hdferr, lapl_id)
+ SUBROUTINE h5oget_info_by_name_f(loc_id, name, object_info, hdferr, lapl_id, fields)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN) :: loc_id
CHARACTER(LEN=*), INTENT(IN) :: name
TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info
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
TYPE(C_PTR) :: ptr
+ INTEGER :: fields_c
INTERFACE
- INTEGER FUNCTION h5oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, object_info) &
+ INTEGER FUNCTION h5oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, object_info, fields) &
BIND(C, NAME='h5oget_info_by_name_c')
IMPORT :: c_char, c_ptr
IMPORT :: HID_T, SIZE_T
@@ -923,10 +967,13 @@ CONTAINS
INTEGER(SIZE_T) , INTENT(IN) :: namelen
INTEGER(HID_T) , INTENT(IN) :: lapl_id_default
TYPE(C_PTR),VALUE :: object_info
-
+ INTEGER , INTENT(IN) :: fields
END FUNCTION h5oget_info_by_name_c
END INTERFACE
+ fields_c = H5O_INFO_ALL_F
+ IF(PRESENT(fields)) fields_c = fields
+
namelen = LEN(name)
lapl_id_default = H5P_DEFAULT_F
@@ -934,7 +981,7 @@ CONTAINS
ptr = C_LOC(object_info)
- hdferr = H5Oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, ptr)
+ hdferr = H5Oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, ptr, fields_c)
END SUBROUTINE H5Oget_info_by_name_f
@@ -953,34 +1000,43 @@ CONTAINS
! object_info - Buffer in which to return object information.
! hdferr - Returns 0 if successful and -1 if fails.
!
+! Optional parameters:
+! fields - Flags specifying the fields to include in object_info.
+!
! AUTHOR
! M. Scot Breitenfeld
! May 11, 2012
!
! Fortran2003 Interface:
- SUBROUTINE h5oget_info_f(object_id, object_info, hdferr)
+ SUBROUTINE h5oget_info_f(object_id, object_info, hdferr, fields)
USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN) :: object_id
TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info
INTEGER , INTENT(OUT) :: hdferr
+ INTEGER , INTENT(IN), OPTIONAL :: fields
!*****
TYPE(C_PTR) :: ptr
-
+ INTEGER :: fields_c
+
INTERFACE
- INTEGER FUNCTION h5oget_info_c(object_id, object_info) &
+ INTEGER FUNCTION h5oget_info_c(object_id, object_info, fields) &
BIND(C, NAME='h5oget_info_c')
IMPORT :: C_PTR
IMPORT :: HID_T
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: object_id
TYPE(C_PTR), VALUE :: object_info
+ INTEGER, INTENT(IN) :: fields
END FUNCTION h5oget_info_c
END INTERFACE
+ fields_c = H5O_INFO_ALL_F
+ IF(PRESENT(fields)) fields_c = fields
+
ptr = C_LOC(object_info)
- hdferr = H5Oget_info_c(object_id, ptr)
+ hdferr = H5Oget_info_c(object_id, ptr, fields_c)
END SUBROUTINE H5Oget_info_f
@@ -1006,6 +1062,7 @@ CONTAINS
!
! Optional parameters:
! lapl_id - Link access property list. (Not currently used.)
+! fields - Flags specifying the fields to include in object_info.
!
! AUTHOR
! M. Scot Breitenfeld
@@ -1013,7 +1070,7 @@ CONTAINS
!
! Fortran2003 Interface:
SUBROUTINE h5oget_info_by_idx_f(loc_id, group_name, index_field, order, n, &
- object_info, hdferr, lapl_id)
+ object_info, hdferr, lapl_id, fields)
USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
@@ -1025,14 +1082,16 @@ CONTAINS
TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info
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
TYPE(C_PTR) :: ptr
+ INTEGER :: fields_c
INTERFACE
INTEGER FUNCTION h5oget_info_by_idx_c(loc_id, group_name, namelen, &
- index_field, order, n, lapl_id_default, object_info) BIND(C, NAME='h5oget_info_by_idx_c')
+ index_field, order, n, lapl_id_default, object_info, fields) BIND(C, NAME='h5oget_info_by_idx_c')
IMPORT :: c_char, c_ptr, c_funptr
IMPORT :: HID_T, SIZE_T, HSIZE_T
INTEGER(HID_T) , INTENT(IN) :: loc_id
@@ -1043,17 +1102,20 @@ CONTAINS
INTEGER(HSIZE_T), INTENT(IN) :: n
INTEGER(HID_T) , INTENT(IN) :: lapl_id_default
TYPE(C_PTR), VALUE :: object_info
-
+ INTEGER, INTENT(IN) :: fields
END FUNCTION h5oget_info_by_idx_c
END INTERFACE
+ fields_c = H5O_INFO_ALL_F
+ IF(PRESENT(fields)) fields_c = fields
+
namelen = LEN(group_name)
lapl_id_default = H5P_DEFAULT_F
IF(PRESENT(lapl_id)) lapl_id_default = lapl_id
ptr = C_LOC(object_info)
- hdferr = H5Oget_info_by_idx_c(loc_id, group_name, namelen, index_field, order, n, lapl_id_default, ptr)
+ hdferr = H5Oget_info_by_idx_c(loc_id, group_name, namelen, index_field, order, n, lapl_id_default, ptr, fields_c)
END SUBROUTINE H5Oget_info_by_idx_f
@@ -1086,6 +1148,7 @@ CONTAINS
!
! Optional parameters:
! lapl_id - Link access property list identifier.
+! fields - Flags specifying the fields to include in object_info.
!
! AUTHOR
! M. Scot Breitenfeld
@@ -1093,7 +1156,7 @@ CONTAINS
!
! Fortran2003 Interface:
SUBROUTINE h5ovisit_by_name_f(loc_id, object_name, index_type, order, op, op_data, &
- return_value, hdferr, lapl_id)
+ return_value, hdferr, lapl_id, fields)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN) :: loc_id
CHARACTER(LEN=*), INTENT(IN) :: object_name
@@ -1105,14 +1168,16 @@ CONTAINS
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
INTERFACE
INTEGER FUNCTION h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, &
- op, op_data, lapl_id) BIND(C, NAME='h5ovisit_by_name_c')
+ op, op_data, lapl_id, fields) BIND(C, NAME='h5ovisit_by_name_c')
IMPORT :: C_CHAR, C_PTR, C_FUNPTR
IMPORT :: HID_T, SIZE_T
IMPLICIT NONE
@@ -1124,16 +1189,20 @@ CONTAINS
TYPE(C_FUNPTR) , VALUE :: op
TYPE(C_PTR) , VALUE :: op_data
INTEGER(HID_T) , INTENT(IN) :: lapl_id
+ INTEGER , INTENT(IN) :: fields
END FUNCTION h5ovisit_by_name_c
END INTERFACE
+ fields_c = H5O_INFO_ALL_F
+ IF(PRESENT(fields)) fields_c = fields
+
namelen = LEN(object_name)
lapl_id_default = H5P_DEFAULT_F
IF(PRESENT(lapl_id)) lapl_id_default = lapl_id
return_value = h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, &
- op, op_data, lapl_id_default)
+ op, op_data, lapl_id_default, fields_c)
IF(return_value.GE.0)THEN
hdferr = 0
diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c
index 352ffab..69ba8b3 100644
--- a/fortran/src/H5_f.c
+++ b/fortran/src/H5_f.c
@@ -556,6 +556,17 @@ h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags,
h5o_flags[24] = (int_f)H5O_TYPE_DATASET; /* Object is a dataset */
h5o_flags[25] = (int_f)H5O_TYPE_NAMED_DATATYPE; /* Object is a named data type */
h5o_flags[26] = (int_f)H5O_TYPE_NTYPES; /* Number of different object types */
+
+/* Flags for H5Oget_info.
+ * These flags determine which fields will be filled in in the H5O_info_t
+ * struct.
+ */
+ h5o_flags[27] = (int_f)H5O_INFO_ALL; /* (H5O_INFO_BASIC|H5O_INFO_TIME|H5O_INFO_NUM_ATTRS|H5O_INFO_HDR|H5O_INFO_META_SIZE) */
+ h5o_flags[28] = (int_f)H5O_INFO_BASIC; /* Fill in the fileno, addr, type, and rc fields */
+ h5o_flags[29] = (int_f)H5O_INFO_TIME; /* Fill in the atime, mtime, ctime, and btime fields */
+ h5o_flags[30] = (int_f)H5O_INFO_NUM_ATTRS; /* Fill in the num_attrs field */
+ h5o_flags[31] = (int_f)H5O_INFO_HDR; /* Fill in the hdr field */
+ h5o_flags[32] = (int_f)H5O_INFO_META_SIZE; /* Fill in the meta_size field */
/*
* H5P flags
*/
diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90
index f63e734..84529e4 100644
--- a/fortran/src/H5_ff.F90
+++ b/fortran/src/H5_ff.F90
@@ -98,8 +98,8 @@ MODULE H5LIB
!
! H5O flags declaration
!
- INTEGER, PARAMETER :: H5O_FLAGS_LEN = 27
- INTEGER, DIMENSION(1:H5O_FLAGS_LEN) :: H5o_flags
+ INTEGER, PARAMETER :: H5O_FLAGS_LEN = 33
+ INTEGER, DIMENSION(1:H5O_FLAGS_LEN) :: H5O_flags
!
! H5P flags declaration
!
@@ -139,8 +139,8 @@ MODULE H5LIB
!
INTEGER, PARAMETER :: H5LIB_FLAGS_LEN = 2
INTEGER, DIMENSION(1:H5LIB_FLAGS_LEN) :: H5LIB_flags
-
- PUBLIC :: h5open_f, h5close_f, h5get_libversion_f, h5dont_atexit_f, h5kind_to_type, h5offsetof
+
+ PUBLIC :: h5open_f, h5close_f, h5get_libversion_f, h5dont_atexit_f, h5kind_to_type, h5offsetof, h5gmtime
PUBLIC :: h5garbage_collect_f, h5check_version_f
CONTAINS
@@ -488,7 +488,13 @@ CONTAINS
H5O_TYPE_GROUP_F = h5o_flags(24)
H5O_TYPE_DATASET_F = h5o_flags(25)
H5O_TYPE_NAMED_DATATYPE_F = h5o_flags(26)
- H5O_TYPE_NTYPES_F = h5o_flags(27)
+ H5O_TYPE_NTYPES_F = h5o_flags(27)
+ H5O_INFO_ALL_F = h5o_flags(28)
+ H5O_INFO_BASIC_F = h5o_flags(29)
+ H5O_INFO_TIME_F = h5o_flags(30)
+ H5O_INFO_NUM_ATTRS_F = h5o_flags(31)
+ H5O_INFO_HDR_F = h5o_flags(32)
+ H5O_INFO_META_SIZE_F = h5o_flags(33)
!
! H5P flags
!
@@ -898,4 +904,62 @@ CONTAINS
END FUNCTION h5offsetof
+!****f* H5LIB_PROVISIONAL/h5gmtime
+!
+! NAME
+! h5gmtime
+!
+! PURPOSE
+! Convert time_t structure (C) to Fortran DATE AND TIME storage format.
+!
+! Inputs:
+! stdtime_t - Object of type time_t that contains a time value
+!
+! Outputs:
+! datetime - A date/time array using Fortran conventions:
+! datetime(1) = year
+! datetime(2) = month
+! datetime(3) = day
+! datetime(4) = 0 ! time is expressed as UTC (or GMT timezone) */
+! datetime(5) = hour
+! datetime(6) = minute
+! datetime(7) = second
+! datetime(8) = millisecond -- not available, assigned - HUGE(0)
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! January, 2019
+!
+! Fortran Interface:
+ FUNCTION h5gmtime(stdtime_t)
+ IMPLICIT NONE
+ INTEGER(KIND=TIME_T), INTENT(IN) :: stdtime_t
+ INTEGER, DIMENSION(1:8) :: h5gmtime
+!*****
+ TYPE(C_PTR) :: cptr
+ INTEGER(C_INT), DIMENSION(:), POINTER :: c_time
+
+ INTERFACE
+ FUNCTION gmtime(stdtime_t) BIND(C, NAME='gmtime')
+ IMPORT :: TIME_T, C_PTR
+ IMPLICIT NONE
+ INTEGER(KIND=TIME_T) :: stdtime_t
+ TYPE(C_PTR) :: gmtime
+ END FUNCTION gmtime
+ END INTERFACE
+
+ cptr = gmtime(stdtime_t)
+ CALL C_F_POINTER(cptr, c_time, [9])
+
+ h5gmtime(1) = INT(c_time(6)+1900) ! year starts at 1900
+ h5gmtime(2) = INT(c_time(5)+1) ! month starts at 0 in C
+ h5gmtime(3) = INT(c_time(4)) ! day
+ h5gmtime(4) = 0 ! time is expressed as UTC (or GMT timezone)
+ h5gmtime(5) = INT(c_time(3)) ! hour
+ h5gmtime(6) = INT(c_time(2)) ! minute
+ h5gmtime(7) = INT(c_time(1)) ! second
+ h5gmtime(8) = -32767 ! millisecond is not available, assign it -HUGE(0)
+
+ END FUNCTION h5gmtime
+
END MODULE H5LIB
diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90
index 078778a..b705cc1 100644
--- a/fortran/src/H5f90global.F90
+++ b/fortran/src/H5f90global.F90
@@ -493,6 +493,13 @@ MODULE H5GLOBAL
!DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_DATASET_F
!DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_NAMED_DATATYPE_F
!DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_NTYPES_F
+ !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_ALL_F
+ !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_BASIC_F
+ !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_TIME_F
+ !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_NUM_ATTRS_F
+ !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_HDR_F
+ !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_META_SIZE_F
+ !
!DEC$endif
INTEGER :: H5O_COPY_SHALLOW_HIERARCHY_F ! *** THESE VARIABLES DO
@@ -522,6 +529,12 @@ MODULE H5GLOBAL
INTEGER :: H5O_TYPE_DATASET_F
INTEGER :: H5O_TYPE_NAMED_DATATYPE_F
INTEGER :: H5O_TYPE_NTYPES_F
+ INTEGER :: H5O_INFO_ALL_F
+ INTEGER :: H5O_INFO_BASIC_F
+ INTEGER :: H5O_INFO_TIME_F
+ INTEGER :: H5O_INFO_NUM_ATTRS_F
+ INTEGER :: H5O_INFO_HDR_F
+ INTEGER :: H5O_INFO_META_SIZE_F
!
! H5P flags declaration
!
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index 46ef8ef..fc6567c 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -315,14 +315,14 @@ H5_FCDLL int_f h5oclose_c(hid_t_f *object_id );
H5_FCDLL int_f h5oopen_by_addr_c(hid_t_f *loc_id, haddr_t_f *addr, 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_iterate_t op, void *op_data);
+H5_FCDLL int_f h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_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_iterate_t op, void *op_data, hid_t_f *lapl_id );
-H5_FCDLL int_f h5oget_info_c(hid_t_f *object_id, H5O_info_t_f *object_info);
+ H5O_iterate_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);
+ int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info, int_f *fields);
H5_FCDLL int_f h5oget_info_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id,
- H5O_info_t_f *object_info);
+ H5O_info_t_f *object_info, int_f *fields);
H5_FCDLL int_f h5ocopy_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len,
hid_t_f *ocpypl_id, hid_t_f *lcpl_id );
diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c
index 7e0b7e8..57f7dda 100644
--- a/fortran/src/H5match_types.c
+++ b/fortran/src/H5match_types.c
@@ -191,6 +191,8 @@ int main(void)
}
if(sizeof(size_t) == IntKinds_SizeOf[i])
writeTypedef("size_t", "size_t", IntKinds[i]);
+ if(sizeof(time_t) == IntKinds_SizeOf[i])
+ writeTypedef("time_t", "time_t", IntKinds[i]);
if(sizeof(hsize_t) == IntKinds_SizeOf[i])
writeTypedef("hsize_t", "hsize_t", IntKinds[i]);
}
@@ -306,6 +308,17 @@ int main(void)
return -1;
}
+ /* time_t */
+ for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) {
+ if(IntKinds_SizeOf[i] == H5_SIZEOF_TIME_T) {
+ writeToFiles("time_t","TIME_T", "time_t_f", IntKinds[i]);
+ break;
+ }
+ if(i == (FORTRAN_NUM_INTEGER_KINDS-1) )
+ /* Error: couldn't find a size for time_t */
+ return -1;
+ }
+
/* int */
writeToFiles("int","Fortran_INTEGER", "int_f", H5_FORTRAN_NATIVE_INTEGER_KIND);
diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in
index f36a5c8..b9e2314 100644
--- a/fortran/src/hdf5_fortrandll.def.in
+++ b/fortran/src/hdf5_fortrandll.def.in
@@ -8,6 +8,7 @@ H5LIB_mp_H5GARBAGE_COLLECT_F
H5LIB_mp_H5DONT_ATEXIT_F
H5LIB_mp_H5KIND_TO_TYPE
H5LIB_mp_H5OFFSETOF
+H5LIB_mp_H5GMTIME
; H5A
H5A_mp_H5AWRITE_CHAR_SCALAR
H5A_mp_H5AREAD_CHAR_SCALAR
diff --git a/fortran/test/tH5O_F03.F90 b/fortran/test/tH5O_F03.F90
index 44c4bff..d1a9ddb 100644
--- a/fortran/test/tH5O_F03.F90
+++ b/fortran/test/tH5O_F03.F90
@@ -58,21 +58,224 @@ MODULE visit_cb
TYPE, bind(c) :: ovisit_ud_t
INTEGER :: idx ! Index in object visit structure
TYPE(obj_visit_t), DIMENSION(1:info_size) :: info ! Pointer to the object visit structure to use
+ INTEGER :: field
END TYPE ovisit_ud_t
CONTAINS
- INTEGER FUNCTION visit_obj_cb( group_id, name, oinfo, op_data) bind(C)
+! Compares the field values of a C h5O_info_t and a Fortran H5O_info_t.
+
+ INTEGER FUNCTION compare_h5o_info_t( oinfo_f, oinfo_c, field, full_f_field ) RESULT(status)
+
+ IMPLICIT NONE
+ TYPE(h5o_info_t) :: oinfo_f
+ TYPE(c_h5o_info_t) :: oinfo_c
+ INTEGER :: field
+ LOGICAL :: full_f_field ! All the fields of Fortran H5O_info_t where filled
+! local
+ INTEGER(C_INT), DIMENSION(1:8) :: atime, btime, ctime, mtime
+ INTEGER :: i
+
+ status = 0
+
+ IF( (field .EQ. H5O_INFO_BASIC_F).OR.(field .EQ. H5O_INFO_ALL_F) )THEN
+ IF( (oinfo_f%fileno.LE.0) .OR. (oinfo_c%fileno .NE. oinfo_f%fileno) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%addr.LE.0) .OR. (oinfo_c%addr .NE. oinfo_f%addr) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%type.LT.0) .OR. (oinfo_c%type .NE. oinfo_f%type) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%rc.LT.0) .OR. (oinfo_c%rc .NE. oinfo_f%rc) )THEN
+ status = -1
+ RETURN
+ ENDIF
+
+ ENDIF
+
+ IF((field .EQ. H5O_INFO_TIME_F).OR.(field .EQ. H5O_INFO_ALL_F))THEN
+
+ atime(1:8) = h5gmtime(oinfo_c%atime)
+ btime(1:8) = h5gmtime(oinfo_c%btime)
+ ctime(1:8) = h5gmtime(oinfo_c%ctime)
+ mtime(1:8) = h5gmtime(oinfo_c%mtime)
+
+ DO i = 1, 8
+ IF( (atime(i) .NE. oinfo_f%atime(i)) )THEN
+ status = -1
+ RETURN
+ ENDIF
+
+ IF( (btime(i) .NE. oinfo_f%btime(i)) )THEN
+ status = -1
+ RETURN
+ ENDIF
+
+ IF( (ctime(i) .NE. oinfo_f%ctime(i)) )THEN
+ status = -1
+ RETURN
+ ENDIF
+
+ IF( (mtime(i) .NE. oinfo_f%mtime(i)) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ ENDDO
+
+ ELSE IF(field .EQ. H5O_INFO_TIME_F.AND. full_f_field)THEN
+ ! check other field values are not filled (using only a small subset to check)
+ status = 0
+ IF( oinfo_c%fileno .NE. oinfo_f%fileno) status = status + 1
+ IF( oinfo_c%addr .NE. oinfo_f%addr) status = status + 1
+ IF( oinfo_c%type .NE. oinfo_f%type) status = status + 1
+ IF( oinfo_c%rc .NE. oinfo_f%rc) status = status + 1
+ IF(status.EQ.0) THEN ! There was no difference found, which is only possible if the field was filled.
+ status = -1
+ RETURN
+ ENDIF
+ status = 0 ! reset
+ ENDIF
+
+ IF((field .EQ. H5O_INFO_NUM_ATTRS_F).OR.(field .EQ. H5O_INFO_ALL_F))THEN
+ IF( (oinfo_f%num_attrs.LT.0) .OR. (oinfo_c%num_attrs .NE. oinfo_f%num_attrs) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ ELSE IF( field .EQ. H5O_INFO_ALL_F.AND.full_f_field)THEN
+ ! check other field values are not filled (using only a small subset to check)
+ status = 0
+ IF( oinfo_c%fileno .NE. oinfo_f%fileno) status = status + 1
+ IF( oinfo_c%addr .NE. oinfo_f%addr) status = status + 1
+ IF( oinfo_c%type .NE. oinfo_f%type) status = status + 1
+ IF( oinfo_c%rc .NE. oinfo_f%rc) status = status + 1
+ IF(status.EQ.0) THEN ! There was no difference found, which is only possible if the field was filled.
+ status = -1
+ RETURN
+ ENDIF
+ status = 0 ! reset
+
+ ENDIF
+
+ IF((field).EQ.H5O_INFO_HDR_F.OR.(field .EQ. H5O_INFO_ALL_F))THEN
+ IF( (oinfo_f%hdr%version.LT.0) .OR. (oinfo_c%hdr%version .NE. oinfo_f%hdr%version) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%nmesgs.LT.0) .OR. (oinfo_c%hdr%nmesgs .NE. oinfo_f%hdr%nmesgs) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%nchunks.LT.0) .OR. (oinfo_c%hdr%nchunks .NE. oinfo_f%hdr%nchunks) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%flags.LT.0) .OR. (oinfo_c%hdr%flags .NE. oinfo_f%hdr%flags) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%space%total.LT.0) .OR. (oinfo_c%hdr%space%total .NE. oinfo_f%hdr%space%total) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%space%meta.LT.0) .OR. (oinfo_c%hdr%space%meta .NE. oinfo_f%hdr%space%meta) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%space%mesg.LT.0) .OR. (oinfo_c%hdr%space%mesg .NE. oinfo_f%hdr%space%mesg) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%space%free.LT.0) .OR. (oinfo_c%hdr%space%free .NE. oinfo_f%hdr%space%free) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%mesg%present.LT.0) .OR. (oinfo_c%hdr%mesg%present .NE. oinfo_f%hdr%mesg%present) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF( (oinfo_f%hdr%mesg%shared.LT.0) .OR. (oinfo_c%hdr%mesg%shared .NE. oinfo_f%hdr%mesg%shared) )THEN
+ status = -1
+ RETURN
+ ENDIF
+ ELSE IF( field .EQ. H5O_INFO_HDR_F.AND.full_f_field)THEN
+ ! check other field values are not filled (using only a small subset to check)
+ status = 0
+ IF( oinfo_c%fileno .NE. oinfo_f%fileno) status = status + 1
+ IF( oinfo_c%addr .NE. oinfo_f%addr) status = status + 1
+ IF( oinfo_c%type .NE. oinfo_f%type) status = status + 1
+ IF( oinfo_c%rc .NE. oinfo_f%rc) status = status + 1
+ IF(status.EQ.0) THEN ! There was no difference found, which is only possible if the field was filled.
+ status = -1
+ RETURN
+ ENDIF
+ status = 0 ! reset
+ ENDIF
+ IF((field).EQ.H5O_INFO_META_SIZE_F.OR.(field .EQ. H5O_INFO_ALL_F))THEN
+ IF((oinfo_f%meta_size%obj%index_size.LT.0).OR.(oinfo_c%meta_size%obj%index_size.NE.oinfo_f%meta_size%obj%index_size))THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF((oinfo_f%meta_size%obj%heap_size.LT.0).OR.(oinfo_c%meta_size%obj%heap_size.NE.oinfo_f%meta_size%obj%heap_size))THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF((oinfo_f%meta_size%attr%index_size.LT.0).OR.(oinfo_c%meta_size%attr%index_size.NE.oinfo_f%meta_size%attr%index_size))THEN
+ status = -1
+ RETURN
+ ENDIF
+ IF((oinfo_f%meta_size%attr%heap_size.LT.0).OR.(oinfo_c%meta_size%attr%heap_size.NE.oinfo_f%meta_size%attr%heap_size))THEN
+ status = -1
+ RETURN
+ ENDIF
+ ELSE IF( field .EQ. H5O_INFO_META_SIZE_F.AND.full_f_field)THEN
+ ! check other field values are not filled (using only a small subset to check)
+ status = 0
+ IF( oinfo_c%fileno .NE. oinfo_f%fileno) status = status + 1
+ IF( oinfo_c%addr .NE. oinfo_f%addr) status = status + 1
+ IF( oinfo_c%type .NE. oinfo_f%type) status = status + 1
+ IF( oinfo_c%rc .NE. oinfo_f%rc) status = status + 1
+ IF(status.EQ.0) THEN ! There was no difference found, which is only possible if the field was filled.
+ status = -1
+ RETURN
+ ENDIF
+ status = 0 ! reset
+ ENDIF
+
+ END FUNCTION compare_h5o_info_t
+
+ INTEGER FUNCTION visit_obj_cb( group_id, name, oinfo_c, op_data) bind(C)
IMPLICIT NONE
INTEGER(HID_T), VALUE :: group_id
CHARACTER(LEN=1), DIMENSION(1:180) :: name
- TYPE(h5o_info_t) :: oinfo
+ CHARACTER(LEN=180) :: name2
+ TYPE(c_h5o_info_t) :: oinfo_c
TYPE(ovisit_ud_t) :: op_data
-
+ TYPE(h5o_info_t) :: oinfo_f
+!
+! MEMBER | TYPE | MEANING | RANGE
+! A(1) = tm_sec int seconds after the minute 0-61*
+! A(2) = tm_min int minutes after the hour 0-59
+! A(3) = tm_hour int hours since midnight 0-23
+! A(4) = tm_mday int day of the month 1-31
+! A(5) = tm_mon int months since January 0-11
+! A(6) = tm_year int years since 1900
+! A(7) = tm_wday int days since Sunday 0-6
+! A(8) = tm_yday int days since January 1 0-365
+! A(9) = tm_isdst int Daylight Saving Time flag
+!
+ INTEGER(C_INT), DIMENSION(:), POINTER :: c_atime, c_btime, c_ctime, c_mtime
+ INTEGER(C_INT), DIMENSION(1:8) :: atime, btime, ctime, mtime
INTEGER :: len, i
INTEGER :: idx
+ INTEGER :: ierr
+ TYPE(C_PTR) :: cptr
visit_obj_cb = 0
@@ -87,21 +290,53 @@ CONTAINS
len = len - 1
! Check for correct object information
+ name2(1:180) = ""
+ DO i = 1, len
+ name2(i:i) = name(i)(1:1)
+ ENDDO
- idx = op_data%idx
+ IF(op_data%field .EQ. H5O_INFO_ALL_F)THEN
- DO i = 1, len
- IF(op_data%info(idx)%path(i)(1:1) .NE. name(i)(1:1))THEN
- visit_obj_cb = -1
- RETURN
- ENDIF
-
- IF(op_data%info(idx)%type_obj .NE. oinfo%type)THEN
- visit_obj_cb = -1
- RETURN
- ENDIF
+ idx = op_data%idx
+
+ DO i = 1, len
+ IF(op_data%info(idx)%path(i)(1:1) .NE. name(i)(1:1))THEN
+ visit_obj_cb = -1
+ RETURN
+ ENDIF
+
+ IF(op_data%info(idx)%type_obj .NE. oinfo_c%type)THEN
+ visit_obj_cb = -1
+ RETURN
+ ENDIF
+ ENDDO
- ENDDO
+ ENDIF
+
+ ! Check H5Oget_info_by_name_f; if partial field values where filled correctly
+ CALL H5Oget_info_by_name_f(group_id, name2, oinfo_f, ierr);
+ visit_obj_cb = compare_h5o_info_t( oinfo_f, oinfo_c, op_data%field, .TRUE. )
+ IF(visit_obj_cb.EQ.-1) RETURN
+
+ ! Check H5Oget_info_by_name_f, only check field values
+ CALL H5Oget_info_by_name_f(group_id, name2, oinfo_f, ierr, fields = op_data%field);
+ visit_obj_cb = compare_h5o_info_t( oinfo_f, oinfo_c, op_data%field, .FALSE. )
+ IF(visit_obj_cb.EQ.-1) RETURN
+
+
+ IF(op_data%idx.EQ.1)THEN
+
+ ! Check H5Oget_info_f, only check field values
+ CALL H5Oget_info_f(group_id, oinfo_f, ierr, fields = op_data%field);
+ visit_obj_cb = compare_h5o_info_t( oinfo_f, oinfo_c, op_data%field, .FALSE. )
+ IF(visit_obj_cb.EQ.-1) RETURN
+
+ ! Check H5Oget_info_f; if partial field values where filled correctly
+ CALL H5Oget_info_f(group_id, oinfo_f, ierr);
+ visit_obj_cb = compare_h5o_info_t( oinfo_f, oinfo_c, op_data%field, .TRUE. )
+ IF(visit_obj_cb.EQ.-1) RETURN
+
+ ENDIF
! Advance to next location in expected output
op_data%idx = op_data%idx + 1
@@ -110,7 +345,6 @@ CONTAINS
END MODULE visit_cb
-
MODULE TH5O_F03
CONTAINS
@@ -310,29 +544,110 @@ SUBROUTINE obj_visit(total_error)
udata%info(9)%type_obj = H5O_TYPE_NAMED_DATATYPE_F
! Visit all the objects reachable from the root group (with file ID)
- udata%idx = 1
fun_ptr = C_FUNLOC(visit_obj_cb)
f_ptr = C_LOC(udata)
! Test h5ovisit_f
+ udata%field = H5O_INFO_ALL_F
+ udata%idx = 1
CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error)
CALL check("h5ovisit_f", error, total_error)
IF(ret_val.LT.0)THEN
CALL check("h5ovisit_f", -1, total_error)
ENDIF
- ! Test h5ovisit_by_name_f
+ ! Test fields option
+ udata%field = H5O_INFO_ALL_F
+ udata%idx = 1
+ CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_f", -1, total_error)
+ ENDIF
+ udata%field = H5O_INFO_BASIC_F
+ udata%idx = 1
+ CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_f", -1, total_error)
+ ENDIF
+ udata%field = H5O_INFO_TIME_F
+ udata%idx = 1
+ CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_f", -1, total_error)
+ ENDIF
+ udata%field = H5O_INFO_NUM_ATTRS_F
+ udata%idx = 1
+ CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_f", -1, total_error)
+ ENDIF
+ udata%field = H5O_INFO_HDR_F
+ udata%idx = 1
+ CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_f", -1, total_error)
+ ENDIF
+ udata%field = H5O_INFO_META_SIZE_F
+ udata%idx = 1
+ CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_f", -1, total_error)
+ ENDIF
+ ! Test h5ovisit_by_name_f
object_name = "/"
udata%idx = 1
-
- CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error)
+ udata%field = H5O_INFO_ALL_F
+ CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
CALL check("h5ovisit_by_name_f", error, total_error)
IF(ret_val.LT.0)THEN
CALL check("h5ovisit_by_name_f", -1, total_error)
ENDIF
+ ! Test fields option
+ udata%idx = 1
+ udata%field = H5O_INFO_BASIC_F
+ CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_by_name_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_by_name_f", -1, total_error)
+ ENDIF
+ udata%idx = 1
+ udata%field = H5O_INFO_TIME_F
+ CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_by_name_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_by_name_f", -1, total_error)
+ ENDIF
+ udata%idx = 1
+ udata%field = H5O_INFO_NUM_ATTRS_F
+ CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_by_name_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_by_name_f", -1, total_error)
+ ENDIF
+ udata%idx = 1
+ udata%field = H5O_INFO_HDR_F
+ CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_by_name_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_by_name_f", -1, total_error)
+ ENDIF
+ udata%idx = 1
+ udata%field = H5O_INFO_META_SIZE_F
+ CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field)
+ CALL check("h5ovisit_by_name_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_by_name_f", -1, total_error)
+ ENDIF
+
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error, total_error)
@@ -450,11 +765,32 @@ SUBROUTINE obj_info(total_error)
IF(oinfo%rc.NE.1)THEN
CALL check("h5oget_info_by_idx_f", -1, total_error)
ENDIF
+ IF(oinfo%type.NE.H5O_TYPE_DATASET_F)THEN
+ CALL check("h5oget_info_by_idx_f", -1, total_error)
+ ENDIF
+ ! Check partial fields
+ CALL h5oget_info_by_idx_f(gid, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, oinfo, error, fields=H5O_INFO_BASIC_F )
+ CALL check("h5oget_info_by_idx_f", error, total_error)
+
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_idx_f", -1, total_error)
+ ENDIF
IF(oinfo%type.NE.H5O_TYPE_DATASET_F)THEN
CALL check("h5oget_info_by_idx_f", -1, total_error)
ENDIF
+ CALL h5oget_info_by_idx_f(gid, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, oinfo, error, fields=H5O_INFO_TIME_F )
+ CALL check("h5oget_info_by_idx_f", error, total_error)
+ ! These field values should not be filled
+ IF(oinfo%rc.EQ.1)THEN
+ CALL check("h5oget_info_by_idx_f", -1, total_error)
+ ENDIF
+ IF(oinfo%type.EQ.H5O_TYPE_DATASET_F)THEN
+ CALL check("h5oget_info_by_idx_f", -1, total_error)
+ ENDIF
+
+
! Close objects
CALL h5dclose_f(did, error)
CALL check("h5dclose_f", error, total_error)
@@ -483,11 +819,12 @@ SUBROUTINE build_visit_file(fid)
USE TH5_MISC
IMPLICIT NONE
- INTEGER(hid_t) :: fid ! File ID
- INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs
+ INTEGER(hid_t) :: fid ! File ID
+ INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs
INTEGER(hid_t) :: sid = -1 ! Dataspace ID
INTEGER(hid_t) :: did = -1 ! Dataset ID
INTEGER(hid_t) :: tid = -1 ! Datatype ID
+ INTEGER(hid_t) :: aid = -1, aid2 = -1, aid3 = -1 ! Attribute ID
CHARACTER(LEN=20) :: filename = 'visit.h5'
INTEGER :: error
@@ -500,6 +837,15 @@ SUBROUTINE build_visit_file(fid)
! Create nested group
CALL H5Gcreate_f(gid, "Group2", gid2, error)
+ CALL H5Screate_f(H5S_SCALAR_F, sid, error)
+ CALL H5Acreate_f(gid2, "Attr1", H5T_NATIVE_INTEGER, sid, aid, error)
+ CALL H5Acreate_f(gid2, "Attr2", H5T_NATIVE_INTEGER, sid, aid2, error)
+ CALL H5Acreate_f(gid2, "Attr3", H5T_NATIVE_INTEGER, sid, aid3, error)
+ CALL H5Aclose_f(aid,error)
+ CALL H5Aclose_f(aid2,error)
+ CALL H5Aclose_f(aid3,error)
+ CALL H5Sclose_f(sid,error)
+
! Close groups
CALL h5gclose_f(gid2, error)
CALL h5gclose_f(gid, error)