diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2012-03-30 00:45:04 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2012-03-30 00:45:04 (GMT) |
commit | d63add741b14efdf55a4bbcc6c79fcd99988ac96 (patch) | |
tree | f958f72d2a6725aeaffe548617076b765e12e923 /hl/fortran | |
parent | e320fb15f8ef82eede9633cd3a0bd9d1395344f2 (diff) | |
download | hdf5-d63add741b14efdf55a4bbcc6c79fcd99988ac96.zip hdf5-d63add741b14efdf55a4bbcc6c79fcd99988ac96.tar.gz hdf5-d63add741b14efdf55a4bbcc6c79fcd99988ac96.tar.bz2 |
[svn-r22206] Merged changes from the trunk in to the branch, used:
svn merge -r r22040:22205 https://svn.hdfgroup.uiuc.edu/hdf5/trunk/hl
Tested: jam (gnu and intel compilers)
Diffstat (limited to 'hl/fortran')
-rw-r--r-- | hl/fortran/src/H5DSfc.c | 4 | ||||
-rw-r--r-- | hl/fortran/src/H5LTf90proto.h | 11 | ||||
-rw-r--r-- | hl/fortran/src/H5LTfc.c | 81 | ||||
-rw-r--r-- | hl/fortran/src/H5LTff.f90 | 77 | ||||
-rw-r--r-- | hl/fortran/test/tstds.f90 | 10 | ||||
-rw-r--r-- | hl/fortran/test/tstlite.f90 | 112 |
6 files changed, 271 insertions, 24 deletions
diff --git a/hl/fortran/src/H5DSfc.c b/hl/fortran/src/H5DSfc.c index 6816347..3135cfa 100644 --- a/hl/fortran/src/H5DSfc.c +++ b/hl/fortran/src/H5DSfc.c @@ -283,7 +283,7 @@ nh5dsget_label_c(hid_t_f *did, int_f *idx, _fcd label, size_t_f *size) * Convert C name to FORTRAN and place it in the given buffer */ - HD5packFstring(c_label, _fcdtocp(label), (size_t)*size+1); + HD5packFstring(c_label, _fcdtocp(label), (size_t)*size); done: *size = (size_t_f)size_c; /* Don't subtract '1' because H5DSget_label doesn't include the @@ -332,7 +332,7 @@ nh5dsget_scale_name_c(hid_t_f *did, _fcd name, size_t_f *size) * Convert C name to FORTRAN and place it in the given buffer */ if(size_c != 0) { - HD5packFstring(c_scale_name, _fcdtocp(name), (size_t)*size+1); + HD5packFstring(c_scale_name, _fcdtocp(name), (size_t)*size); *size = (size_t_f)size_c-1; /* (-1) because we don't include the NULL ending in the length*/ } else { *size = (size_t_f)size_c; /* if NULL then no name was found */ diff --git a/hl/fortran/src/H5LTf90proto.h b/hl/fortran/src/H5LTf90proto.h index eda8ed8..bf13c0b 100644 --- a/hl/fortran/src/H5LTf90proto.h +++ b/hl/fortran/src/H5LTf90proto.h @@ -149,6 +149,7 @@ H5_FCDLL void HD5packFstring (char *src, char *dest, size_t len); #define nh5ltget_attribute_ndims_c H5_FC_FUNC_(h5ltget_attribute_ndims_c, H5LTGET_ATTRIBUTE_NDIMS_C) #define nh5ltget_attribute_info_c H5_FC_FUNC_(h5ltget_attribute_info_c, H5LTGET_ATTRIBUTE_INFO_C) +#define nh5ltpath_valid_c H5_FC_FUNC_(h5ltpath_valid_c, H5LTPATH_VALID_C) /*------------------------------------------------------------------------- * Image @@ -1139,7 +1140,8 @@ nh5ltget_attribute_string_c(hid_t_f *loc_id, _fcd dsetname, int_f *attrnamelen, _fcd attrname, - void *buf); + _fcd buf, + size_t_f *buf_size); HDF5_HL_F90CSTUBDLL int_f @@ -1197,6 +1199,13 @@ nh5ltread_dataset_string_c (hid_t_f *loc_id, _fcd name, char *buf); +HDF5_HL_F90CSTUBDLL +int_f +nh5ltpath_valid_c(hid_t_f *loc_id, + _fcd path, + int_f *pathlen, + int_f *check_object_valid_c); + /*------------------------------------------------------------------------- * Image *------------------------------------------------------------------------- diff --git a/hl/fortran/src/H5LTfc.c b/hl/fortran/src/H5LTfc.c index 484acf1..674636d 100644 --- a/hl/fortran/src/H5LTfc.c +++ b/hl/fortran/src/H5LTfc.c @@ -17,8 +17,7 @@ #include "H5LTprivate.h" #include "H5LTf90proto.h" - - +#include "H5Eprivate.h" /*------------------------------------------------------------------------- * Function: H5LTmake_dataset_c @@ -1719,13 +1718,13 @@ nh5ltget_attribute_string_c(hid_t_f *loc_id, _fcd dsetname, int_f *attrnamelen, _fcd attrname, - void *buf) + _fcd buf, size_t_f *buf_size) { int ret_value = -1; herr_t ret; - hid_t c_loc_id; char *c_name = NULL; char *c_attrname = NULL; + char *c_buf = NULL; int c_namelen; int c_attrnamelen; @@ -1741,26 +1740,33 @@ nh5ltget_attribute_string_c(hid_t_f *loc_id, c_attrname = (char *)HD5f2cstring(attrname, c_attrnamelen); if (c_attrname == NULL) goto done; - /* - * Call H5LTget_attribute_int function. - */ - c_loc_id = (hid_t)*loc_id; - - ret = H5LTget_attribute_string(c_loc_id,c_name,c_attrname,buf); + * Allocate buffer to hold C attribute string + */ + if ((c_buf = HDmalloc((size_t)*buf_size + 1)) == NULL) + goto done; + /* + * Call H5LTget_attribute_int function. + */ + ret = H5LTget_attribute_string((hid_t)*loc_id,c_name,c_attrname,c_buf); if (ret < 0) goto done; - ret_value = 0; + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + HD5packFstring(c_buf, _fcdtocp(buf), (size_t)*buf_size); + ret_value = 0; done: if(c_name!=NULL) free(c_name); if(c_attrname!=NULL) free(c_attrname); - + if(c_buf!=NULL) + free(c_buf); return ret_value; } @@ -2124,3 +2130,54 @@ done: return ret_value; } + +/*------------------------------------------------------------------------- +* Function: h5ltpath_valid_c +* +* Purpose: Calls h5ltpath_valid +* +* Return: Success: 0, Failure: -1 +* +* Programmer: M. Scot Breitenfeld +* +* Date: February 18, 2012 +* +* Comments: +* +* Modifications: +* +* +*------------------------------------------------------------------------- +*/ + +int_f +nh5ltpath_valid_c(hid_t_f *loc_id, + _fcd path, + int_f *pathlen, + int_f *check_object_valid_c) +{ + htri_t ret = -1; + char *c_path = NULL; + hbool_t check_object_valid; + + /* + * convert FORTRAN name to C name + */ + if( NULL == (c_path = (char *)HD5f2cstring(path, (size_t)*pathlen))) + goto done; + + check_object_valid = FALSE; + if(*check_object_valid_c == 1) + check_object_valid = TRUE; + + /* + * call H5LTpath_valid function. + */ + ret = H5LTpath_valid( (hid_t)*loc_id, c_path, check_object_valid ); + +done: + if(c_path != NULL) + free(c_path); + + return (int_f)ret; +} diff --git a/hl/fortran/src/H5LTff.f90 b/hl/fortran/src/H5LTff.f90 index cbc9b96..b384821 100644 --- a/hl/fortran/src/H5LTff.f90 +++ b/hl/fortran/src/H5LTff.f90 @@ -5969,9 +5969,10 @@ CONTAINS CHARACTER(len=*), INTENT(inout) :: buf ! data buffer INTEGER :: namelen ! name length INTEGER :: attrlen ! name length + INTEGER(size_t) :: buf_size ! buf size INTERFACE - INTEGER FUNCTION h5ltget_attribute_string_c(loc_id,namelen,dset_name,attrlen,attr_name,buf) + INTEGER FUNCTION h5ltget_attribute_string_c(loc_id,namelen,dset_name,attrlen,attr_name,buf,buf_size) USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5LTGET_ATTRIBUTE_STRING_C'::h5ltget_attribute_string_c @@ -5984,12 +5985,15 @@ CONTAINS CHARACTER(len=*), INTENT(in) :: dset_name ! name of the dataset CHARACTER(len=*), INTENT(in) :: attr_name ! name of the attribute CHARACTER(len=*), INTENT(inout) :: buf ! data buffer + INTEGER(size_t) :: buf_size ! data buffer size END FUNCTION h5ltget_attribute_string_c END INTERFACE namelen = LEN(dset_name) attrlen = LEN(attr_name) - errcode = h5ltget_attribute_string_c(loc_id,namelen,dset_name,attrlen,attr_name,buf) + buf_size = LEN(buf) + + errcode = h5ltget_attribute_string_c(loc_id,namelen,dset_name,attrlen,attr_name,buf,buf_size) END SUBROUTINE h5ltget_attribute_string_f @@ -6308,6 +6312,75 @@ CONTAINS errcode = h5ltget_attribute_info_c(loc_id,namelen,dset_name,attrlen,attr_name,dims,type_class,type_size) END SUBROUTINE h5ltget_attribute_info_f + + !------------------------------------------------------------------------- + ! Function: h5ltpath_valid_f + ! + ! Purpose: Validates a path + ! + ! Return: Success: 0, Failure: -1 + ! + ! Programmer: M. Scot Breitenfeld + ! + ! Date: February 18, 2012 + ! + ! Comments: + ! + ! Modifications: + ! + !------------------------------------------------------------------------- + + SUBROUTINE h5ltpath_valid_f(loc_id, path, check_object_valid, path_valid, errcode) + + IMPLICIT NONE + ! + !This definition is needed for Windows DLLs + !DEC$if defined(BUILD_HDF5_DLL) + !DEC$attributes dllexport :: h5ltpath_valid_f + !DEC$endif + ! + INTEGER(hid_t) , INTENT(IN) :: loc_id ! File or group identifier. + CHARACTER(LEN=*), INTENT(IN) :: path ! Path to the object to check, relative to loc_id. + LOGICAL , INTENT(IN) :: check_object_valid ! Indicates whether to check if the final component + ! of the path resolves to a valid object + LOGICAL , INTENT(OUT) :: path_valid ! Object status + INTEGER , INTENT(OUT) :: errcode ! Error code: 0 on success and -1 on failure + + INTEGER :: pathlen + INTEGER :: check_object_valid_c + INTEGER :: status + + INTERFACE + INTEGER FUNCTION h5ltpath_valid_c(loc_id, path, pathlen, check_object_valid_c) + USE h5global + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5LTPATH_VALID_C'::h5ltpath_valid_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: path + INTEGER(hid_t), INTENT(in) :: loc_id + CHARACTER(len=*), INTENT(in) :: path + INTEGER :: pathlen + INTEGER :: check_object_valid_c + END FUNCTION h5ltpath_valid_c + END INTERFACE + + ! Initialize + path_valid = .FALSE. + errcode = 0 + + check_object_valid_c = 0 + IF(check_object_valid) check_object_valid_c = 1 + + pathlen = LEN(path) + status = h5ltpath_valid_c(loc_id, path, pathlen, check_object_valid_c) + + IF(status.EQ.1)THEN + path_valid = .TRUE. + ELSE IF(status.LT.0)THEN + errcode = -1 + ENDIF + + END SUBROUTINE h5ltpath_valid_f ! end ! END MODULE H5LT diff --git a/hl/fortran/test/tstds.f90 b/hl/fortran/test/tstds.f90 index 8817989..c73e1c4 100644 --- a/hl/fortran/test/tstds.f90 +++ b/hl/fortran/test/tstds.f90 @@ -186,7 +186,10 @@ SUBROUTINE test_testds(err) name_len = 25 name = '' CALL H5DSget_scale_name_f(dsid, name, name_len, err) - IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimension Scale Set 1")THEN + IF(err.LT.0 .OR. & + name_len.NE.21 .OR. & + TRIM(name).NE."Dimension Scale Set 1" .OR. & + name(22:25).NE.' ')THEN err = FAILED CALL write_test_status(err) RETURN @@ -293,7 +296,10 @@ SUBROUTINE test_testds(err) label_len = 25 label = '' CALL H5DSget_label_f(did, DIM2, label, label_len, err) - IF(err.LT.0.OR.label(1:label_len).NE."Label12".OR.label_len.NE.7)THEN + IF(err.LT.0.OR. & + label(1:label_len).NE."Label12" .OR. & + label_len.NE.7 .OR. & + label(8:25).NE.' ')THEN err = FAILED CALL write_test_status(err) RETURN diff --git a/hl/fortran/test/tstlite.f90 b/hl/fortran/test/tstlite.f90 index b0e28f9..0b5a138 100644 --- a/hl/fortran/test/tstlite.f90 +++ b/hl/fortran/test/tstlite.f90 @@ -1067,6 +1067,9 @@ SUBROUTINE test_datasets() INTEGER :: has ! general purpose integer INTEGER :: type_class INTEGER(SIZE_T) :: type_size + LOGICAL :: path_valid ! status of the path + CHARACTER(LEN=6) :: chr_exact + CHARACTER(LEN=8) :: chr_lg ! ! Initialize FORTRAN predefined datatypes. @@ -1118,6 +1121,7 @@ SUBROUTINE test_datasets() CALL passed() + !------------------------------------------------------------------------- ! real !------------------------------------------------------------------------- @@ -1207,9 +1211,60 @@ SUBROUTINE test_datasets() CALL passed() + CALL test_begin(' Test h5ltpath_valid_f ') + ! + ! test function h5ltpath_valid_f + ! + chr_exact = "/"//dsetname2 ! test character buffer the exact size needed + CALL h5ltpath_valid_f(file_id, chr_exact, .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + chr_lg = "/"//dsetname2 ! test character buffer larger then needed + CALL h5ltpath_valid_f(file_id, chr_lg, .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + CALL h5ltpath_valid_f(file_id, chr_lg, .FALSE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + ! Should fail, dataset does not exist + CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .FALSE., path_valid, errcode) + IF(errcode.LT.0.OR.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + ! Create a dangling soft link + CALL h5lcreate_soft_f("/G2", file_id, "/G3", errcode) + + ! Should pass, does not check for dangled link + CALL h5ltpath_valid_f(file_id, "/G3", .FALSE., path_valid, errcode) + IF(.NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + ! Should fail, dangled link + CALL h5ltpath_valid_f(file_id, "/G2", .TRUE., path_valid, errcode) + IF(path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + CALL passed() CALL test_begin(' Get dataset dimensions/info ') @@ -1287,7 +1342,9 @@ SUBROUTINE test_attributes() IMPLICIT NONE CHARACTER(len=9), PARAMETER :: filename = "dsetf5.h5"! File name + CHARACTER(len=9), PARAMETER :: filename1 ="tattr.h5" ! C written attribute file INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: file_id1 INTEGER, PARAMETER :: DIM1 = 10; ! Dimension of array CHARACTER(LEN=5), PARAMETER :: attrname1 = "attr1" ! Attribute name CHARACTER(LEN=5), PARAMETER :: attrname2 = "attr2" ! Attribute name @@ -1295,7 +1352,11 @@ SUBROUTINE test_attributes() CHARACTER(LEN=5), PARAMETER :: attrname4 = "attr4" ! Attribute name CHARACTER(LEN=5), PARAMETER :: attrname5 = "attr5" ! Attribute name CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer + CHARACTER(LEN=16), PARAMETER :: buf_c = "string attribute" CHARACTER(LEN=8) :: bufr1 ! Data buffer + CHARACTER(LEN=10) :: bufr1_lg ! Data buffer + CHARACTER(LEN=16) :: bufr_c ! Data buffer + CHARACTER(LEN=18) :: bufr_c_lg ! Data buffer INTEGER, DIMENSION(DIM1) :: buf2 ! Data buffer INTEGER, DIMENSION(DIM1) :: bufr2 ! Data buffer REAL, DIMENSION(DIM1) :: buf3 ! Data buffer @@ -1313,6 +1374,7 @@ SUBROUTINE test_attributes() INTEGER :: rank = 1 ! Dataset rank CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name INTEGER, DIMENSION(DIM1) :: buf ! Data buffer + ! ! Initialize FORTRAN predefined datatypes. @@ -1431,35 +1493,75 @@ SUBROUTINE test_attributes() CALL passed() - - !------------------------------------------------------------------------- ! string !------------------------------------------------------------------------- CALL test_begin(' Set/Get attributes string ') - ! ! write attribute. ! CALL h5ltset_attribute_string_f(file_id,dsetname1,attrname5,buf1,errcode) ! - ! read attribute. + ! read attribute into a fortran character buf that is the same size as buf1. ! CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1,errcode) ! ! compare read and write buffers. ! - IF ( buf1 .NE. bufr1 ) THEN PRINT *, 'read buffer differs from write buffer' PRINT *, buf1, ' and ', bufr1 STOP ENDIF + ! + ! read attribute into a fortran character buf that is larger then buf1. + ! + CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1_lg,errcode) + + ! + ! compare read and write buffers, make sure C NULL character was removed. + ! + IF ( buf1(1:8) .NE. bufr1_lg(1:8) .AND. bufr1_lg(9:10) .NE. ' ' ) THEN + PRINT *, 'larger read buffer differs from write buffer' + PRINT *, buf1, ' and ', bufr1_lg + STOP + ENDIF + + ! + ! ** Test reading a string that was created with a C program ** + ! + +!!$ CALL h5fopen_f(filename1, H5F_ACC_RDONLY_F, file_id1, errcode) +!!$ +!!$ CALL h5ltget_attribute_string_f(file_id1, "/", "attr5", bufr_c, errcode) +!!$ ! +!!$ ! compare read and write buffers. +!!$ ! +!!$ IF ( bufr_c .NE. buf_c ) THEN +!!$ PRINT *, 'read buffer differs from write buffer' +!!$ PRINT *, bufr1, ' and ', buf_c +!!$ STOP +!!$ ENDIF +!!$ ! +!!$ ! read attribute into a fortran character buf that is larger then buf_c. +!!$ ! +!!$ CALL h5ltget_attribute_string_f(file_id1, "/", "attr5", bufr_c_lg, errcode) +!!$ +!!$ ! +!!$ ! compare read and write buffers, make sure C NULL character was removed. +!!$ ! +!!$ IF ( buf_c(1:16) .NE. bufr_c_lg(1:16) .AND. bufr_c_lg(17:18) .NE. ' ' ) THEN +!!$ PRINT *, 'larger read buffer differs from write buffer' +!!$ PRINT *, buf_c, ' and ', bufr_c_lg +!!$ STOP +!!$ ENDIF + +!!$ CALL h5fclose_f(file_id1, errcode) CALL passed() |