diff options
Diffstat (limited to 'fortran/test/tH5G_1_8.f90')
| -rw-r--r-- | fortran/test/tH5G_1_8.f90 | 150 |
1 files changed, 85 insertions, 65 deletions
diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90 index 6a2c623..fd55ba9 100644 --- a/fortran/test/tH5G_1_8.f90 +++ b/fortran/test/tH5G_1_8.f90 @@ -1,3 +1,12 @@ +!****h* root/fortran/test/tH5G_1_8.f90 +! +! NAME +! tH5G_1_8.f90 +! +! FUNCTION +! Basic testing of Fortran H5G APIs introduced in 1.8. +! +! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * @@ -13,6 +22,12 @@ ! access to either file, you may request a copy from help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! +! CONTAINS SUBROUTINES +! group_test, group_info, timestamps, mklinks, test_move_preserves, lifecycle +! cklinks, delete_by_idx, link_info_by_idx_check, test_lcpl, objcopy, +! lapl_nlinks +! +!***** SUBROUTINE group_test(cleanup, total_error) USE HDF5 ! This module contains all necessary modules @@ -1057,6 +1072,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL check("h5_cleanup_f", error, total_error) END SUBROUTINE lifecycle + !/*------------------------------------------------------------------------- ! * Function: cklinks ! * @@ -1070,7 +1086,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) ! * Programmer: M.S. Breitenfeld ! * April 14, 2008 ! * -! * Modifications: Modified Original C code +! * Modifications: Modified original C code ! * ! *------------------------------------------------------------------------- ! */ @@ -1118,10 +1134,10 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL H5Lexists_f(file,"d1",Lexists, error) - CALL verifylogical("test_lcpl.H5Lexists", Lexists,.TRUE.,total_error) + CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error) CALL H5Lexists_f(file,"grp1/hard",Lexists, error) - CALL verifylogical("test_lcpl.H5Lexists", Lexists,.TRUE.,total_error) + CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error) ! /* Cleanup */ CALL H5Fclose_f(file,error) @@ -1490,7 +1506,6 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! *------------------------------------------------------------------------- ! */ - SUBROUTINE test_lcpl(cleanup, fapl, total_error) USE HDF5 ! This module contains all necessary modules @@ -1542,13 +1557,13 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! h5_fixname(FILENAME[0], fapl, filename, sizeof filename); CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) - CALL check("test_lcpl.H5Fcreate_f", error, total_error) + CALL check("H5Fcreate_f", error, total_error) ! /* Create and link a group with the default LCPL */ CALL H5Gcreate_f(file_id, "/group", group_id, error) - CALL check("test_lcpl.H5Gcreate_f", error, total_error) + CALL check("H5Gcreate_f", error, total_error) ! /* Check that its character encoding is the default */ @@ -1561,49 +1576,54 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! * creation property list and is always ASCII. */ !#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- - CALL VERIFY("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + CALL VERIFY("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) ! /* Create and commit a datatype with the default LCPL */ CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error) - CALL check("test_lcpl.h5tcopy_f",error,total_error) + CALL check("h5tcopy_f",error,total_error) CALL h5tcommit_f(file_id, "/type", type_id, error) - CALL check("test_lcpl.h5tcommit_f", error, total_error) + CALL check("h5tcommit_f", error, total_error) CALL h5tclose_f(type_id, error) - CALL check("test_lcpl.h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) ! /* Check that its character encoding is the default */ CALL H5Lget_info_f(file_id, "type", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) !/* File-wide default character encoding can not yet be set via the file ! * creation property list and is always ASCII. */ !#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) !/* Create a dataspace */ CALL h5screate_simple_f(2, dims, space_id, error) - CALL check("test_lcpl.h5screate_simple_f",error,total_error) + CALL check("h5screate_simple_f",error,total_error) + CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) + CALL h5pset_chunk_f(crp_list, 2, dims, error) + CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) + CALL h5pset_chunk_f(crp_list, 2, dims, error) CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) CALL h5pset_chunk_f(crp_list, 2, dims, error) ! /* Create a dataset using the default LCPL */ CALL h5dcreate_f(file_id, "/dataset", H5T_NATIVE_INTEGER, space_id, dset_id, error, crp_list) - CALL check("test_lcpl.h5dcreate_f", error, total_error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dclose_f(dset_id, error) - CALL check("test_lcpl.h5dclose_f", error, total_error) + CALL check("h5dclose_f", error, total_error) ! Reopen CALL H5Dopen_f(file_id, "/dataset", dset_id, error) - CALL check("test_lcpl.h5dopen_f", error, total_error) + CALL check("h5dopen_f", error, total_error) ! /* Extend the dataset */ CALL H5Dset_extent_f(dset_id, extend_dim, error) - CALL check("test_lcpl.H5Dset_extent_f", error, total_error) + CALL check("H5Dset_extent_f", error, total_error) ! /* Verify the dataspaces */ ! !Get dataset's dataspace handle. @@ -1612,7 +1632,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("h5dget_space_f",error,total_error) CALL h5sget_simple_extent_dims_f(data_space, dimsout, maxdimsout, error) - CALL check("test_lcpl.h5sget_simple_extent_dims_f",error, total_error) + CALL check("h5sget_simple_extent_dims_f",error, total_error) DO i = 1, 2 tmp1 = dimsout(i) @@ -1628,170 +1648,170 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! /* close data set */ CALL h5dclose_f(dset_id, error) - CALL check("test_lcpl.h5dclose_f", error, total_error) + CALL check("h5dclose_f", error, total_error) ! /* Check that its character encoding is the default */ CALL H5Lget_info_f(file_id, "dataset", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL check("H5Lget_info_f", error, total_error) !/* File-wide default character encoding can not yet be set via the file ! * creation property list and is always ASCII. */ !#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- - CALL verify("test_lcpl.h5tclose_f",cset, H5T_CSET_ASCII_F,total_error) + CALL verify("h5tclose_f",cset, H5T_CSET_ASCII_F,total_error) !/* Create a link creation property list with the UTF-8 character encoding */ CALL H5Pcreate_f(H5P_LINK_CREATE_F,lcpl_id,error) - CALL check("test_lcpl.h5Pcreate_f",error,total_error) + CALL check("h5Pcreate_f",error,total_error) CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) - CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + CALL check("H5Pset_char_encoding_f",error, total_error) ! /* Create and link a group with the new LCPL */ CALL H5Gcreate_f(file_id, "/group2", group_id, error,lcpl_id=lcpl_id) - CALL check("test_lcpl.test_lcpl.H5Gcreate_f", error, total_error) + CALL check("H5Gcreate_f", error, total_error) CALL H5Gclose_f(group_id, error) - CALL check("test_lcpl.test_lcpl.H5Gclose_f", error, total_error) + CALL check("H5Gclose_f", error, total_error) !/* Check that its character encoding is UTF-8 */ CALL H5Lget_info_f(file_id, "group2", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) ! /* Create and commit a datatype with the new LCPL */ CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error) - CALL check("test_lcpl.h5tcopy_f",error,total_error) + CALL check("h5tcopy_f",error,total_error) CALL h5tcommit_f(file_id, "/type2", type_id, error, lcpl_id=lcpl_id) - CALL check("test_lcpl.h5tcommit_f", error, total_error) + CALL check("h5tcommit_f", error, total_error) CALL h5tclose_f(type_id, error) - CALL check("test_lcpl.h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) !/* Check that its character encoding is UTF-8 */ CALL H5Lget_info_f(file_id, "type2", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) ! /* Create a dataset using the new LCPL */ CALL h5dcreate_f(file_id, "/dataset2", H5T_NATIVE_INTEGER, space_id, dset_id, error,lcpl_id=lcpl_id) - CALL check("test_lcpl.h5dcreate_f", error, total_error) + CALL check("h5dcreate_f", error, total_error) CALL h5dclose_f(dset_id, error) - CALL check("test_lcpl.h5dclose_f", error, total_error) + CALL check("h5dclose_f", error, total_error) CALL H5Pget_char_encoding_f(lcpl_id, encoding, error) - CALL check("test_lcpl.H5Pget_char_encoding_f", error, total_error) - CALL VERIFY("test_lcpl.H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error) + CALL check("H5Pget_char_encoding_f", error, total_error) + CALL VERIFY("H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error) ! /* Check that its character encoding is UTF-8 */ CALL H5Lget_info_f(file_id, "dataset2", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f2",cset, H5T_CSET_UTF8_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f2",cset, H5T_CSET_UTF8_F,total_error) ! /* Create a new link to the dataset with a different character encoding. */ CALL H5Pclose_f(lcpl_id, error) - CALL check("test_lcpl.H5Pclose_f", error, total_error) + CALL check("H5Pclose_f", error, total_error) CALL H5Pcreate_f(H5P_LINK_CREATE_F,lcpl_id,error) - CALL check("test_lcpl.h5Pcreate_f",error,total_error) + CALL check("h5Pcreate_f",error,total_error) CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_ASCII_F, error) - CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + CALL check("H5Pset_char_encoding_f",error, total_error) CALL H5Lcreate_hard_f(file_id, "/dataset2", file_id, "/dataset2_link", error, lcpl_id) - CALL check("test_lcpl.H5Lcreate_hard_f",error, total_error) + CALL check("H5Lcreate_hard_f",error, total_error) CALL H5Lexists_f(file_id,"/dataset2_link",Lexists, error) - CALL check("test_lcpl.H5Lexists",error, total_error) - CALL verifylogical("test_lcpl.H5Lexists", Lexists,.TRUE.,total_error) + CALL check("H5Lexists",error, total_error) + CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error) ! /* Check that its character encoding is ASCII */ CALL H5Lget_info_f(file_id, "/dataset2_link", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) ! /* Check that the first link's encoding hasn't changed */ CALL H5Lget_info_f(file_id, "/dataset2", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f3",cset, H5T_CSET_UTF8_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f3",cset, H5T_CSET_UTF8_F,total_error) !/* Make sure that LCPLs work properly for other API calls: */ !/* H5Lcreate_soft */ CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) - CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + CALL check("H5Pset_char_encoding_f",error, total_error) CALL H5Lcreate_soft_f("dataset2", file_id, "slink_to_dset2",error,lcpl_id) CALL check("H5Lcreate_soft_f", error, total_error) CALL H5Lget_info_f(file_id, "slink_to_dset2", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) ! /* H5Lmove */ CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_ASCII_F, error) - CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + CALL check("H5Pset_char_encoding_f",error, total_error) CALL H5Lmove_f(file_id, "slink_to_dset2", file_id, "moved_slink", error, lcpl_id, H5P_DEFAULT_F) - CALL check("test_lcpl.H5Lmove_f",error, total_error) + CALL check("H5Lmove_f",error, total_error) CALL H5Lget_info_f(file_id, "moved_slink", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) ! /* H5Lcopy */ CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) - CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + CALL check("H5Pset_char_encoding_f",error, total_error) CALL H5Lcopy_f(file_id, "moved_slink", file_id, "copied_slink", error, lcpl_id) CALL H5Lget_info_f(file_id, "copied_slink", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) ! /* H5Lcreate_external */ - CALL H5Lcreate_external_f("test_lcpl.filename", "path", file_id, "extlink", error, lcpl_id) - CALL check("test_lcpl.H5Lcreate_external_f", error, total_error) + CALL H5Lcreate_external_f("filename", "path", file_id, "extlink", error, lcpl_id) + CALL check("H5Lcreate_external_f", error, total_error) CALL H5Lget_info_f(file_id, "extlink", & cset, corder, f_corder_valid, link_type, address, val_size, & error) - CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + CALL check("H5Lget_info_f", error, total_error) + CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) ! /* Close open IDs */ CALL H5Pclose_f(lcpl_id, error) - CALL check("test_lcpl.H5Pclose_f", error, total_error) + CALL check("H5Pclose_f", error, total_error) CALL H5Sclose_f(space_id, error) - CALL check("test_lcpl.h5Sclose_f",error,total_error) + CALL check("h5Sclose_f",error,total_error) CALL H5Fclose_f(file_id, error) - CALL check("test_lcpl.H5Fclose_f", error, total_error) + CALL check("H5Fclose_f", error, total_error) IF(cleanup) CALL h5_cleanup_f("tempfile", H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) |