mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-01-18 15:15:56 +08:00
Code Issues Packages Projects Releases Wiki Activity

HDFFV-10443: Add "field" parameter to H5Oinfo* and H5Ovisit* APIs.

Browse Source
This commit is contained in:
Scot Breitenfeld 2018-12-05 10:45:54 -06:00 committed by M. Scot Breitenfeld
parent 1421059cfb
commit b4d4d371a0
14 changed files with 602 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
config/cmake_ext_mod/ConfigureChecks.cmake
View File

@ -413,6 +413,7 @@ HDF_CHECK_TYPE_SIZE (off64_t ${HDF_PREFIX}_SIZEOF_OFF64_T)
if (NOT ${HDF_PREFIX}_SIZEOF_OFF64_T)
set (${HDF_PREFIX}_SIZEOF_OFF64_T 0)
endif ()
HDF_CHECK_TYPE_SIZE (time_t ${HDF_PREFIX}_SIZEOF_TIME_T)
#-----------------------------------------------------------------------------
# Extra C99 types

9
configure.ac
View File

@ -1210,6 +1210,15 @@ EOF
AC_CHECK_SIZEOF([bool])
fi
AC_CHECK_SIZEOF(time_t, [], [
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_TIME_H
#include <time.h>
#endif
])
## Checkpoint the cache
AC_CACHE_SAVE

48
fortran/src/H5Of.c
View File

@ -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, (uint)*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, (uint)*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, (uint)*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, (uint)*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, (uint)*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 */

98
fortran/src/H5Off.F90
View File

@ -83,7 +83,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 +98,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(hdr_t) :: hdr
TYPE(meta_size_t) :: meta_size
END TYPE c_h5o_info_t
!*****
CONTAINS
@ -834,12 +856,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 +875,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 +890,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 +926,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 +958,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 +972,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 +991,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 +1053,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 +1061,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 +1073,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 +1093,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 +1139,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 +1147,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 +1159,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 +1180,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

11
fortran/src/H5_f.c
View File

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

73
fortran/src/H5_ff.F90
View File

@ -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,61 @@ 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
TYPE(C_PTR) FUNCTION gmtime(stdtime_t) BIND(C, NAME='gmtime')
IMPORT :: TIME_T, C_PTR
IMPLICIT NONE
INTEGER(KIND=TIME_T) :: stdtime_t
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

13
fortran/src/H5f90global.F90
View File

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

10
fortran/src/H5f90proto.h
View File

@ -314,14 +314,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 );

13
fortran/src/H5match_types.c
View File

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

1
fortran/src/hdf5_fortrandll.def.in
View File

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

394
fortran/test/tH5O_F03.F90
View File

@ -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,22 +290,54 @@ CONTAINS
len = len - 1
! Check for correct object information
idx = op_data%idx
name2(1:180) = ""
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
name2(i:i) = name(i)(1:1)
ENDDO
IF(op_data%field .EQ. H5O_INFO_ALL_F)THEN
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
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)

7
src/H5Oint.c
View File

@ -125,12 +125,7 @@ const H5O_msg_class_t *const H5O_msg_class_g[] = {
H5O_MSG_REFCOUNT, /*0x0016 Object's ref. count */
H5O_MSG_FSINFO, /*0x0017 Free-space manager info */
H5O_MSG_MDCI, /*0x0018 Metadata cache image */
H5O_MSG_UNKNOWN, /*0x0019 Placeholder for unknown message */
#ifdef H5O_ENABLE_BOGUS
H5O_MSG_BOGUS_INVALID, /*0x001A "Bogus invalid" (for testing) */
#else /* H5O_ENABLE_BOGUS */
NULL, /*0x001A "Bogus invalid" (for testing) */
#endif /* H5O_ENABLE_BOGUS */
H5O_MSG_UNKNOWN /*0x0019 Placeholder for unknown message */
};
/* Format version bounds for object header */

1
src/H5Pprivate.h
View File

@ -44,6 +44,7 @@ typedef struct H5P_genplist_t H5P_genplist_t;
#define H5_COLL_MD_READ_FLAG_NAME "collective_metadata_read"
/****************************/
/* Library Private Typedefs */
/****************************/

3
src/H5private.h
View File

@ -568,9 +568,6 @@
#define H5_PB (1024.0F * 1024.0F * 1024.0F * 1024.0F * 1024.0F)
#define H5_EB (1024.0F * 1024.0F * 1024.0F * 1024.0F * 1024.0F * 1024.0F)
/* Define 2GB -- Used for 2GB limitation checks */
#define H5_2GB (2.0F * 1024.0F * 1024.0F * 1024.0F)
#ifndef H5_HAVE_FLOCK
/* flock() operations. Used in the source so we have to define them when
* the call is not available (e.g.: Windows). These should NOT be used