mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-03-31 17:10:47 +08:00
Code Issues Packages Projects Releases Wiki Activity

[svn-r17482]

Browse Source 
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)
This commit is contained in:
Scot Breitenfeld 2009-09-15 15:19:02 -05:00
parent 8537263df1
commit 84527bc7ac
7 changed files with 165 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
fortran/src/H5Lf.c
View File

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

32
fortran/src/H5Lff.f90
View File

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

25
fortran/src/H5Of.c
View File

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

44
fortran/src/H5Off.f90
View File

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

12
fortran/src/H5f90proto.h
View File

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

1
fortran/src/hdf5_fortrandll.def
View File

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

75
fortran/test/tH5G_1_8.f90
View File

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