diff options
Diffstat (limited to 'fortran/test/tH5L_F03.F90')
| -rw-r--r-- | fortran/test/tH5L_F03.F90 | 276 |
1 files changed, 270 insertions, 6 deletions
diff --git a/fortran/test/tH5L_F03.F90 b/fortran/test/tH5L_F03.F90 index e09ad5e..426e005 100644 --- a/fortran/test/tH5L_F03.F90 +++ b/fortran/test/tH5L_F03.F90 @@ -27,11 +27,21 @@ ! test_iter_group ! !***** + +MODULE EXTENTS + + IMPLICIT NONE + + INTEGER, PARAMETER :: MAX_CHAR_LEN = 30 + +END MODULE EXTENTS + MODULE liter_cb_mod USE HDF5 USE TH5_MISC USE TH5_MISC_GEN + USE EXTENTS USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE @@ -44,7 +54,7 @@ MODULE liter_cb_mod ! Custom group iteration callback data TYPE, bind(c) :: iter_info - CHARACTER(KIND=C_CHAR), DIMENSION(1:10) :: name ! The name of the object + CHARACTER(KIND=C_CHAR), DIMENSION(1:MAX_CHAR_LEN) :: name ! The name of the object INTEGER(c_int) :: TYPE ! The TYPE of the object INTEGER(c_int) :: command ! The TYPE of RETURN value END TYPE iter_info @@ -62,7 +72,7 @@ CONTAINS IMPLICIT NONE INTEGER(HID_T), VALUE :: group - CHARACTER(LEN=1), DIMENSION(1:10) :: name + CHARACTER(LEN=1), DIMENSION(1:MAX_CHAR_LEN) :: name TYPE (H5L_info_t) :: link_info @@ -72,13 +82,23 @@ CONTAINS INTEGER, SAVE :: count INTEGER, SAVE :: count2 + INTEGER :: nlen, i + liter_cb = 0 !!$ iter_info *info = (iter_info *)op_data; !!$ static int count = 0; !!$ static int count2 = 0; - - op_data%name(1:10) = name(1:10) + nlen = 0 + DO i = 1, MAX_CHAR_LEN + IF( name(i) .EQ. CHAR(0) )THEN + nlen = i - 1 + EXIT + ENDIF + ENDDO + IF(nlen.NE.0)THEN + op_data%name(1:nlen) = name(1:nlen) + ENDIF SELECT CASE (op_data%command) @@ -105,6 +125,67 @@ CONTAINS END FUNCTION liter_cb END MODULE liter_cb_mod +MODULE lvisit_cb_mod + + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + USE EXTENTS + USE, INTRINSIC :: ISO_C_BINDING + IMPLICIT NONE + + ! Custom group iteration callback data + TYPE, bind(c) :: visit_info + CHARACTER(KIND=C_CHAR), DIMENSION(1:11*MAX_CHAR_LEN) :: name ! The name of the object + INTEGER(c_int) :: TYPE ! The TYPE of the object + INTEGER(c_int) :: command ! The TYPE of RETURN value + INTEGER(c_int) :: n_obj ! The TYPE of RETURN value + END TYPE visit_info + +CONTAINS + +!*************************************************************** +!** +!** lvisit_cb(): Custom link visit callback routine. +!** +!*************************************************************** + + INTEGER(KIND=C_INT) FUNCTION lvisit_cb(group, name, link_info, op_data) bind(C) + + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: group + CHARACTER(LEN=1), DIMENSION(1:MAX_CHAR_LEN) :: name + + TYPE(H5L_info_t) :: link_info + TYPE(visit_info) :: op_data + + INTEGER :: nlen, i, istart, iend + + op_data%n_obj = op_data%n_obj + 1 + + nlen = 1 + DO i = 1, MAX_CHAR_LEN + IF( name(i) .EQ. CHAR(0) )THEN + nlen = i - 1 + EXIT + ENDIF + ENDDO + IF(nlen.NE.0)THEN + istart = (op_data%n_obj-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + !PRINT*,istart, iend, name(1:nlen) + op_data%name(istart:istart+nlen-1) = name(1:nlen) + !op_data%name((op_data%n_obj-1)*MAX_CHAR_LEN)(1:nlen) = name(1:nlen) + !PRINT*,op_data%name(istart:istart+nlen) + ENDIF + + ! PRINT*,op_data%name + lvisit_cb = 0 + + END FUNCTION lvisit_cb +END MODULE lvisit_cb_mod + MODULE TH5L_F03 CONTAINS @@ -119,12 +200,14 @@ CONTAINS !** test_iter_group(): Test group iteration functionality !** !*************************************************************** -SUBROUTINE test_iter_group(total_error) +SUBROUTINE test_iter_group(cleanup, total_error) USE liter_cb_mod IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: fapl INTEGER(HID_T) :: file ! File ID INTEGER(hid_t) :: dataset ! Dataset ID @@ -165,7 +248,6 @@ SUBROUTINE test_iter_group(total_error) f1 = C_FUNLOC(liter_cb) f2 = C_LOC(info) - CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error) CALL check("H5Literate_f", error, total_error) @@ -311,6 +393,188 @@ SUBROUTINE test_iter_group(total_error) CALL H5Fclose_f(file, error) CALL check("H5Fclose_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f("titerate", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + END SUBROUTINE test_iter_group +!*************************************************************** +!** +!** Test HL visit functionality +!** +!*************************************************************** +SUBROUTINE test_visit(cleanup, total_error) + + USE lvisit_cb_mod + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: fapl + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: gid, gid2 ! Group IDs + INTEGER(HID_T) :: sid ! Dataspace ID + INTEGER(HID_T) :: did ! Dataset ID + CHARACTER(LEN=11) :: DATAFILE = "tvisit.h5" + + TYPE(C_FUNPTR) :: f1 + TYPE(C_PTR) :: f2 + TYPE(visit_info), TARGET :: udata + + CHARACTER(LEN=MAX_CHAR_LEN), DIMENSION(1:11) :: obj_list + CHARACTER(LEN=MAX_CHAR_LEN) :: tmp + INTEGER :: error + INTEGER :: istart, iend, i, j + + obj_list(1) = "Dataset_zero" + obj_list(2) = "Group1" + obj_list(3) = "Group1/Dataset_one" + obj_list(4) = "Group1/Group2" + obj_list(5) = "Group1/Group2/Dataset_two" + obj_list(6) = "hard_one" + obj_list(7) = "hard_two" + obj_list(8) = "hard_zero" + obj_list(9) = "soft_dangle" + obj_list(10) = "soft_one" + obj_list(11) = "soft_two" + + fid = H5I_INVALID_HID_F + gid = H5I_INVALID_HID_F + gid2 = H5I_INVALID_HID_F + sid = H5I_INVALID_HID_F + did = H5I_INVALID_HID_F + + ! Get the default FAPL + CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + + ! Set the "use the latest version of the format" bounds for creating objects in the file + CALL H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) + CALL check("H5Pset_libver_bounds_f",error, total_error) + + ! Create the test file with the datasets + CALL h5fcreate_f(DATAFILE, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl) + CALL check("h5fcreate_f", error, total_error) + + ! Create group + CALL h5gcreate_f(fid, "/Group1", gid, error) + CALL check("h5gcreate_f", error, total_error) + + ! Create nested group + CALL h5gcreate_f(gid, "Group2", gid2, error) + CALL check("h5gcreate_f", error, total_error) + + ! Close groups + CALL h5gclose_f(gid2, error) + CALL check("h5gclose_f", error, total_error) + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f", error, total_error) + + ! Create soft links to groups created + CALL h5lcreate_soft_f("/Group1", fid, "/soft_one", error) + CALL check("h5lcreate_soft_f", error, total_error) + + CALL h5lcreate_soft_f("/Group1/Group2", fid, "/soft_two", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create dangling soft link + CALL h5lcreate_soft_f("nowhere", fid, "/soft_dangle", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create hard links to all groups + CALL h5lcreate_hard_f(fid, "/", fid, "hard_zero", error) + CALL check("h5lcreate_hard_f1", error, total_error) + + CALL h5lcreate_hard_f(fid, "/Group1", fid, "hard_one", error) + CALL check("h5lcreate_hard_f2", error, total_error) + CALL h5lcreate_hard_f(fid, "/Group1/Group2", fid, "hard_two", error) + CALL check("h5lcreate_hard_f3", error, total_error) + + ! Create dataset in each group + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f", error, total_error) + + CALL h5dcreate_f(fid, "/Dataset_zero", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dcreate_f(fid, "/Group1/Dataset_one", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dcreate_f(fid, "/Group1/Group2/Dataset_two", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f3", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f", error, total_error) + + ! Test visit functions + + f1 = C_FUNLOC(lvisit_cb) + f2 = C_LOC(udata) + + udata%n_obj = 0 + udata%name(:) = " " + CALL h5lvisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, error) + CALL check("h5lvisit_f", error, total_error) + + IF(udata%n_obj.NE.11)THEN + CALL check("h5lvisit_f: Wrong number of objects visited", -1, total_error) + ENDIF + + DO i = 1, udata%n_obj + istart = (i-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + tmp = " " + DO j = 1, MAX_CHAR_LEN + IF(udata%name(istart+j-1) .NE. " ")THEN + tmp(j:j) = udata%name(istart+j-1) + ELSE + EXIT + ENDIF + ENDDO + IF( TRIM(tmp) .NE. TRIM(obj_list(i)(:)) )THEN + CALL check("h5lvisit_f: Wrong object list from visit", -1, total_error) + EXIT + ENDIF + ENDDO + + udata%n_obj = 0 + udata%name(:) = " " + CALL h5lvisit_by_name_f(fid, "/", H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, error) + CALL check("h5lvisit_by_name_f", error, total_error) + + IF(udata%n_obj.NE.11)THEN + CALL check("h5lvisit_by_name_f: Wrong number of objects visited", -1, total_error) + ENDIF + + DO i = 1, udata%n_obj + istart = (i-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + tmp = " " + DO j = 1, MAX_CHAR_LEN + IF(udata%name(istart+j-1) .NE. " ")THEN + tmp(j:j) = udata%name(istart+j-1) + ELSE + EXIT + ENDIF + ENDDO + IF( TRIM(tmp) .NE. TRIM(obj_list(i)(:)) )THEN + CALL check("h5lvisit_by_name_f: Wrong object list from visit", -1, total_error) + EXIT + ENDIF + ENDDO + + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("tvisit", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + +END SUBROUTINE test_visit + END MODULE TH5L_F03 |