diff options
author | Rick <rzamora@anl.gov> | 2019-03-01 15:54:32 (GMT) |
---|---|---|
committer | Rick <rzamora@anl.gov> | 2019-03-01 15:54:32 (GMT) |
commit | e0fce1826abcd6ccf26694f7fa283e20792c5dfa (patch) | |
tree | 36622f0e60894ca84715138085433c515609cf17 /fortran/test/tH5O_F03.F90 | |
parent | 324b829c42b1058c8818d76209b1d4ac79d27bac (diff) | |
parent | 10cdff5ca45786832bf5e6c3e3408bc725464fd6 (diff) | |
download | hdf5-e0fce1826abcd6ccf26694f7fa283e20792c5dfa.zip hdf5-e0fce1826abcd6ccf26694f7fa283e20792c5dfa.tar.gz hdf5-e0fce1826abcd6ccf26694f7fa283e20792c5dfa.tar.bz2 |
merging changes in develop into ccio
Diffstat (limited to 'fortran/test/tH5O_F03.F90')
-rw-r--r-- | fortran/test/tH5O_F03.F90 | 390 |
1 files changed, 368 insertions, 22 deletions
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) |