summaryrefslogtreecommitdiffstats
path: root/hl/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2012-03-30 00:45:04 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2012-03-30 00:45:04 (GMT)
commitd63add741b14efdf55a4bbcc6c79fcd99988ac96 (patch)
treef958f72d2a6725aeaffe548617076b765e12e923 /hl/fortran
parente320fb15f8ef82eede9633cd3a0bd9d1395344f2 (diff)
downloadhdf5-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.c4
-rw-r--r--hl/fortran/src/H5LTf90proto.h11
-rw-r--r--hl/fortran/src/H5LTfc.c81
-rw-r--r--hl/fortran/src/H5LTff.f9077
-rw-r--r--hl/fortran/test/tstds.f9010
-rw-r--r--hl/fortran/test/tstlite.f90112
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()