From 84527bc7ac95a86ec04fac16872408f8139eb29c Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Tue, 15 Sep 2009 15:19:02 -0500 Subject: [svn-r17482] Bug 1652 - h5lget_info_by_idx_f missing/broken functionalit * added returned val_sel, link_type and address that were missing In the process, fixed the integer type in H5lget_info_f for address and val_sel * wrote test for val_sel, address, and link_type returned values * to check address values added h5Oopen_by_addr_f function and test program. Tested: smirom (pgf90/pgcc, ifort/icc) linew jam (gcc/g95) --- fortran/src/H5Lf.c | 12 ++++--- fortran/src/H5Lff.f90 | 32 +++++++++++------- fortran/src/H5Of.c | 25 ++++++++++++++ fortran/src/H5Off.f90 | 44 ++++++++++++++++++++++++ fortran/src/H5f90proto.h | 12 ++++--- fortran/src/hdf5_fortrandll.def | 1 + fortran/test/tH5G_1_8.f90 | 75 +++++++++++++++++++++++++++++++++-------- 7 files changed, 165 insertions(+), 36 deletions(-) diff --git a/fortran/src/H5Lf.c b/fortran/src/H5Lf.c index 4378f33..2832d44 100644 --- a/fortran/src/H5Lf.c +++ b/fortran/src/H5Lf.c @@ -396,7 +396,7 @@ done: int_f nh5lget_info_c (hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, int_f *cset, int_f *corder, int_f *corder_valid, int_f *link_type, - int_f *address, hsize_t_f *val_size, + haddr_t_f *address, size_t_f *val_size, hid_t_f *lapl_id) { char *c_link_name = NULL; /* Buffer to hold C string */ @@ -421,8 +421,8 @@ nh5lget_info_c (hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, *corder_valid = 0; if(link_buff.corder_valid > 0) *corder_valid = 1; *link_type = (int_f)link_buff.type; - *address = (int_f)link_buff.u.address; - *val_size = (hsize_t)link_buff.u.val_size; + *address = (haddr_t_f)link_buff.u.address; + *val_size = (size_t_f)link_buff.u.val_size; done: return ret_value; @@ -453,7 +453,7 @@ done: int_f nh5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, int_f *index_field, int_f *order, hsize_t_f *n, - int_f *corder_valid, int_f *corder, int_f *cset, hsize_t_f *data_size, hid_t_f *lapl_id) + int_f *link_type, int_f *corder_valid, int_f *corder, int_f *cset, haddr_t_f *address, size_t_f *val_size, hid_t_f *lapl_id) { char *c_group_name = NULL; /* Buffer to hold C string */ H5_index_t c_index_field; @@ -483,7 +483,9 @@ nh5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, *corder = (int_f)link_buff.corder; *cset = (int_f)link_buff.cset; - *data_size = (hsize_t)link_buff.u.val_size; + *link_type = (int_f)link_buff.type; + *address = (haddr_t_f)link_buff.u.address; + *val_size = (size_t_f)link_buff.u.val_size; done: return ret_value; diff --git a/fortran/src/H5Lff.f90 b/fortran/src/H5Lff.f90 index b1a0fd9..0023e14 100644 --- a/fortran/src/H5Lff.f90 +++ b/fortran/src/H5Lff.f90 @@ -574,7 +574,7 @@ CONTAINS ! ! cset - indicates the character set used for link’s name. ! corder - specifies the link’s creation order position. -!corder_valid - indicates whether the value in corder is valid. +!f_corder_valid - indicates whether the value in corder is valid. ! link_type - specifies the link class: ! H5L_LINK_HARD_F - Hard link ! H5L_LINK_SOFT_F - Soft link @@ -612,8 +612,8 @@ CONTAINS ! H5L_LINK_SOFT_F - Soft link ! H5L_LINK_EXTERNAL_F - External link ! H5L_LINK_ERROR _F - Error - INTEGER, INTENT(OUT) :: address ! If the link is a hard link, address specifies the file address that the link points to - INTEGER(HSIZE_T), INTENT(OUT) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value + INTEGER(HADDR_T), INTENT(OUT) :: address ! If the link is a hard link, address specifies the file address that the link points to + INTEGER(SIZE_T), INTENT(OUT) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value INTEGER, INTENT(OUT) :: hdferr ! Error code: ! 0 on success and -1 on failure INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list @@ -638,8 +638,8 @@ CONTAINS INTEGER, INTENT(OUT) :: cset INTEGER, INTENT(OUT) :: corder INTEGER, INTENT(OUT) :: link_type - INTEGER, INTENT(OUT) :: address - INTEGER(HSIZE_T), INTENT(OUT) :: val_size + INTEGER(HADDR_T), INTENT(OUT) :: address + INTEGER(SIZE_T), INTENT(OUT) :: val_size INTEGER(HID_T) :: lapl_id_default INTEGER(SIZE_T) :: link_namelen INTEGER :: corder_valid @@ -691,7 +691,7 @@ CONTAINS ! !---------------------------------------------------------------------- SUBROUTINE h5lget_info_by_idx_f(loc_id, group_name, index_field, order, n, & - f_corder_valid, corder, cset, data_size, hdferr, lapl_id) + link_type, f_corder_valid, corder, cset, address, val_size, hdferr, lapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier specifying location of subject group CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of subject group @@ -706,10 +706,16 @@ CONTAINS ! H5_ITER_DEC_F - Decreasing order ! H5_ITER_NATIVE_F - No particular order, whatever is fastest INTEGER(HSIZE_T), INTENT(IN) :: n ! Attribute’s position in index + INTEGER, INTENT(OUT) :: link_type ! Specifies the link class: + ! H5L_LINK_HARD_F - Hard link + ! H5L_LINK_SOFT_F - Soft link + ! H5L_LINK_EXTERNAL_F - External link + ! H5L_LINK_ERROR _F - Error LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute INTEGER, INTENT(OUT) :: corder ! Is a positive integer containing the creation order of the attribute INTEGER, INTENT(OUT) :: cset ! Indicates the character set used for the attribute’s name - INTEGER(HSIZE_T), INTENT(OUT) :: data_size ! Indicates the size, in the number of characters, of the attribute + INTEGER(HADDR_T), INTENT(OUT) :: address ! If the link is a hard link, address specifies the file address that the link points to + INTEGER(SIZE_T), INTENT(OUT) :: val_size ! Indicates the size, in the number of characters, of the attribute for symbolic link INTEGER, INTENT(OUT) :: hdferr ! Error code: ! 0 on success and -1 on failure INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list @@ -721,22 +727,24 @@ CONTAINS ! INTERFACE INTEGER FUNCTION h5lget_info_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & - corder_valid, corder, cset, data_size, lapl_id_default) + link_type, corder_valid, corder, cset, address, val_size, lapl_id_default) USE H5GLOBAL !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5LGET_INFO_BY_IDX_C'::h5lget_info_by_idx_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: group_name - INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: group_name INTEGER(SIZE_T) :: group_namelen INTEGER, INTENT(IN) :: index_field INTEGER, INTENT(IN) :: order INTEGER(HSIZE_T), INTENT(IN) :: n - INTEGER :: corder_valid + INTEGER, INTENT(OUT) :: link_type + INTEGER :: corder_valid INTEGER, INTENT(OUT) :: corder INTEGER, INTENT(OUT) :: cset - INTEGER(HSIZE_T), INTENT(OUT) :: data_size + INTEGER(HADDR_T), INTENT(OUT) :: address + INTEGER(SIZE_T), INTENT(OUT) :: val_size INTEGER(HID_T) :: lapl_id_default END FUNCTION h5lget_info_by_idx_c END INTERFACE @@ -747,7 +755,7 @@ CONTAINS IF(PRESENT(lapl_id)) lapl_id_default = lapl_id hdferr = h5lget_info_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & - corder_valid, corder, cset, data_size, lapl_id_default) + link_type, corder_valid, corder, cset, address, val_size, lapl_id_default) f_corder_valid =.FALSE. IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c index 5282dd6..56cbfeb 100644 --- a/fortran/src/H5Of.c +++ b/fortran/src/H5Of.c @@ -97,3 +97,28 @@ nh5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid return ret_value; } +/*---------------------------------------------------------------------------- + * Name: h5oopen_by_addr_c + * Purpose: Calls H5open_by_addr + * Inputs: loc_id - File or group identifier + * addr - Object’s address in the file + * Outputs: obj_id - Dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: M. Scot Breitenfeld + * September 14, 2009 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id) +{ + int_f ret_value = 0; /* Return value */ + + /* + * Call H5Oopen_by_address function. + */ + if((*obj_id = (hid_t_f)H5Oopen_by_addr((hid_t)*loc_id, (haddr_t)*addr)) < 0) + HGOTO_DONE(FAIL); + + done: + return ret_value; +} diff --git a/fortran/src/H5Off.f90 b/fortran/src/H5Off.f90 index a541502..0328fbc 100644 --- a/fortran/src/H5Off.f90 +++ b/fortran/src/H5Off.f90 @@ -153,5 +153,49 @@ CONTAINS END SUBROUTINE h5oopen_f +!---------------------------------------------------------------------- +! Name: h5oopen_by_addr_f +! +! Purpose: Opens an object using its address within an HDF5 file. +! +! Inputs: +! loc_id - File or group identifier +! addr - Object’s address in the file +! Outputs: +! obj_id - Object identifier for the opened object +! hdferr: - error code +! Success: 0 +! Failure: -1 +! +! Programmer: M. Scot Breitenfeld +! September 14, 2009 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5oopen_by_addr_f(loc_id, addr, obj_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + INTEGER(HADDR_T), INTENT(IN) :: addr ! Object’s address in the file + INTEGER(HID_T), INTENT(OUT) :: obj_id ! Object identifier for the opened object + INTEGER, INTENT(OUT) :: hdferr ! Error code + ! Success: 0 + ! Failure: -1 + INTERFACE + INTEGER FUNCTION h5oopen_by_addr_c(loc_id, addr, obj_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OOPEN_BY_ADDR_C'::h5oopen_by_addr_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER(HADDR_T), INTENT(IN) :: addr + INTEGER(HID_T), INTENT(OUT) :: obj_id + END FUNCTION h5oopen_by_addr_c + END INTERFACE + + hdferr = h5oopen_by_addr_c(loc_id, addr, obj_id) + + END SUBROUTINE h5oopen_by_addr_f END MODULE H5O diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 15dc41d..7f16359 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -739,11 +739,13 @@ H5_FCDLL int_f nh5tget_native_type_c(hid_t_f *dtype_id, int_f *direction, hid_t_ * Functions from H5Of.c */ -# define nh5olink_c H5_FC_FUNC_(h5olink_c, H5OLINK_C) -# define nh5oopen_c H5_FC_FUNC_(h5oopen_c, H5OOPEN_C) +# define nh5olink_c H5_FC_FUNC_(h5olink_c, H5OLINK_C) +# define nh5oopen_c H5_FC_FUNC_(h5oopen_c, H5OOPEN_C) +# define nh5oopen_by_addr_c H5_FC_FUNC_(h5oopen_by_addr_c, H5OOPEN_BY_ADDR_C) H5_FCDLL int_f nh5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id); +H5_FCDLL int_f nh5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id); H5_FCDLL int_f nh5olink_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); /* @@ -1201,11 +1203,11 @@ H5_FCDLL int_f nh5ldelete_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f * H5_FCDLL int_f nh5lexists_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, int_f *link_exists); H5_FCDLL int_f nh5lget_info_c (hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, int_f *cset, int_f *corder, int_f *corder_valid, int_f *link_type, - int_f *address, hsize_t_f *link_len, + haddr_t_f *address, size_t_f *val_size, hid_t_f *lapl_id); H5_FCDLL int_f nh5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, - int_f *index_field, int_f *order, hsize_t_f *n, - int_f *corder_valid, int_f *corder, int_f *cset, hsize_t_f *data_size, hid_t_f *lapl_id); + int_f *index_field, int_f *order, hsize_t_f *n, + int_f *link_type, int_f *corder_valid, int_f *corder, int_f *cset, haddr_t_f *address, size_t_f *val_size, hid_t_f *lapl_id); H5_FCDLL int_f nh5lis_registered_c(int_f *link_cls_id); H5_FCDLL int_f nh5lmove_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_namelen, hid_t_f *dest_loc_id, _fcd dest_name, size_t_f *dest_namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id); diff --git a/fortran/src/hdf5_fortrandll.def b/fortran/src/hdf5_fortrandll.def index 057dc13..5f45350 100644 --- a/fortran/src/hdf5_fortrandll.def +++ b/fortran/src/hdf5_fortrandll.def @@ -286,6 +286,7 @@ H5L_mp_H5LGET_NAME_BY_IDX_F ; H5O H5O_mp_H5OLINK_F H5O_mp_H5OOPEN_F +H5O_mp_H5OOPEN_BY_ADDR_F ; H5P H5P_mp_H5PCREATE_F H5P_mp_H5PSET_PRESERVE_F diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90 index 42dd617..9c28f75 100644 --- a/fortran/test/tH5G_1_8.f90 +++ b/fortran/test/tH5G_1_8.f90 @@ -642,6 +642,18 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER :: arank = 1 ! Attribure rank INTEGER :: error + INTEGER :: cset ! Indicates the character set used for the link’s name. + INTEGER :: corder ! Specifies the link’s creation order position. + LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. + INTEGER :: link_type ! Specifies the link class: + ! H5L_LINK_HARD_F - Hard link + ! H5L_LINK_SOFT_F - Soft link + ! H5L_LINK_EXTERNAL_F - External link + ! H5L_LINK_ERROR _F - Error + INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to + INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value + + ! WRITE(*,*) "link creation (w/new group format)" ! /* Create a file */ @@ -670,6 +682,18 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL H5Lcreate_soft_f("/d1", file, "grp1/soft",error) CALL check("H5Lcreate_soft_f", error, total_error) + CALL H5Lget_info_f(file, "grp1/soft", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error, H5P_DEFAULT_F) + CALL check("H5Lget_info_f",error,total_error) + +! CALL VerifyLogical("H5Lget_info_by_idx_f11", f_corder_valid, .TRUE., total_error) + + CALL VERIFY("H5Lget_info_by_idx_f", H5L_LINK_SOFT_F, link_type, total_error) + CALL VERIFY("H5Lget_info_by_idx_f", cset, H5T_CSET_ASCII_F, total_error) + ! should be '/d1' + NULL character = 4 + CALL VERIFY("H5Lget_info_by_idx_f", INT(val_size), 4, total_error) + !/* Create a symbolic link to something that doesn't exist */ CALL H5Lcreate_soft_f("foobar", file, "grp1/dangle",error) @@ -733,8 +757,8 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! H5L_LINK_SOFT_F - Soft link ! H5L_LINK_EXTERNAL_F - External link ! H5L_LINK_ERROR _F - Error - INTEGER :: address ! If the link is a hard link, address specifies the file address that the link points to - INTEGER(HSIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value + INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to + INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value INTEGER :: error @@ -1147,15 +1171,18 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name - INTEGER(HSIZE_T) :: data_size ! Indicates the size, in the number of characters, of the attribute + INTEGER(SIZE_T) :: val_size + INTEGER :: link_type + INTEGER(HADDR_T) :: address INTEGER :: u ! /* Local index variable */ INTEGER :: Input1, i INTEGER(HID_T) :: group_id2 - + INTEGER(HID_T) :: grp INTEGER :: iorder ! /* Order within in the index */ CHARACTER(LEN=2) :: chr2 INTEGER :: error + INTEGER :: id_type ! ! ! @@ -1263,7 +1290,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) htmp =9 !EP CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(u,HSIZE_T), error) CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, htmp, error) - CALL VERIFY("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1) + CALL VERIFY("H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1) ! /* Delete links from compact group */ @@ -1271,19 +1298,37 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) DO u = 0, (max_compact - 1) -1 ! /* Delete first link in appropriate order */ CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error) - CALL check("delete_by_idx.H5Ldelete_by_idx_f", error, total_error) + CALL check("H5Ldelete_by_idx_f", error, total_error) ! /* Verify the link information for first link in appropriate order */ ! HDmemset(&linfo, 0, sizeof(linfo)); CALL H5Lget_info_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), & - f_corder_valid, corder, cset, data_size, error) + link_type, f_corder_valid, corder, cset, address, val_size, error) + + CALL H5Oopen_by_addr_f(group_id, address, grp, error) + CALL check("H5Oopen_by_addr_f", error, total_error) + + CALL H5Iget_type_f(grp, id_type, error) + CALL check("H5Iget_type_f", error, total_error) + + CALL VERIFY("H5Iget_type_f", id_type, H5I_GROUP_F, total_error) + + CALL H5Gclose_f(grp, error) + CALL check("H5Gclose_f", error, total_error) + + CALL VerifyLogical("H5Lget_info_by_idx_f", f_corder_valid, .TRUE., total_error) + CALL VERIFY("H5Lget_info_by_idx_f", H5L_LINK_HARD_F, link_type, total_error) IF(iorder.EQ.H5_ITER_INC_F)THEN - CALL VERIFY("delete_by_idx.H5Lget_info_by_idx_f", corder, u+1, total_error) + CALL VERIFY("H5Lget_info_by_idx_f", corder, u+1, total_error) ELSE - CALL VERIFY("delete_by_idx.H5Lget_info_by_idx_f", corder, (max_compact - (u + 2)), total_error) + CALL VERIFY("H5Lget_info_by_idx_f", corder, (max_compact - (u + 2)), total_error) ENDIF + CALL VERIFY("H5Lget_info_by_idx_f",cset, H5T_CSET_ASCII_F, total_error) + + + ! /* Verify the name for first link in appropriate order */ ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); !!$ size_tmp = 20 @@ -1357,7 +1402,9 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name - INTEGER(HSIZE_T) :: data_size ! Indicates the size, in the number of characters, of the attribute + INTEGER :: link_type + INTEGER(HADDR_T) :: address + INTEGER(SIZE_T) :: val_size ! Indicates the size, in the number of characters, of the attribute CHARACTER(LEN=7) :: tmpname !/* Temporary link name */ CHARACTER(LEN=3) :: tmpname_small !/* to small temporary link name */ @@ -1376,14 +1423,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! /* Verify the link information for first link, in increasing creation order */ ! HDmemset(&linfo, 0, sizeof(linfo)); CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,HSIZE_T), & - f_corder_valid, corder, cset, data_size, error) + link_type, f_corder_valid, corder, cset, address, val_size, error) CALL check("H5Lget_info_by_idx_f", error, total_error) CALL VERIFY("H5Lget_info_by_idx_f", corder, 0, total_error) ! /* Verify the link information for new link, in increasing creation order */ ! HDmemset(&linfo, 0, sizeof(linfo)); CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), & - f_corder_valid, corder, cset, data_size, error) + link_type, f_corder_valid, corder, cset, address, val_size, error) CALL check("H5Lget_info_by_idx_f", error, total_error) CALL VERIFY("H5Lget_info_by_idx_f", corder, n, total_error) @@ -1468,8 +1515,8 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! H5L_LINK_SOFT_F - Soft link ! H5L_LINK_EXTERNAL_F - External link ! H5L_LINK_ERROR _F - Error - INTEGER :: address ! If the link is a hard link, address specifies the file address that the link points to - INTEGER(HSIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value + INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to + INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value CHARACTER(LEN=1024) :: filename = 'tempfile.h5' INTEGER, PARAMETER :: TEST6_DIM1 = 8, TEST6_DIM2 = 7 -- cgit v0.12