summaryrefslogtreecommitdiffstats
path: root/hl/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'hl/fortran')
-rwxr-xr-xhl/fortran/src/H5LTf90proto.h8
-rwxr-xr-xhl/fortran/src/H5LTfc.c51
-rwxr-xr-xhl/fortran/src/H5LTff.f9067
-rw-r--r--hl/fortran/test/tstlite.f9087
4 files changed, 211 insertions, 2 deletions
diff --git a/hl/fortran/src/H5LTf90proto.h b/hl/fortran/src/H5LTf90proto.h
index 5525af9..3d2ae3b 100755
--- 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
@@ -1197,6 +1198,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..c0b7695 100755
--- a/hl/fortran/src/H5LTfc.c
+++ b/hl/fortran/src/H5LTfc.c
@@ -2124,3 +2124,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, (int)*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..7d53ab7 100755
--- a/hl/fortran/src/H5LTff.f90
+++ b/hl/fortran/src/H5LTff.f90
@@ -6308,6 +6308,73 @@ 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
+
+ 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)
+
+ path_valid = .FALSE.
+ errcode = 0
+ 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/tstlite.f90 b/hl/fortran/test/tstlite.f90
index b0e28f9..9329dba 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 ')
@@ -1296,6 +1351,8 @@ SUBROUTINE test_attributes()
CHARACTER(LEN=5), PARAMETER :: attrname5 = "attr5" ! Attribute name
CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer
CHARACTER(LEN=8) :: bufr1 ! Data buffer
+ CHARACTER(LEN=10) :: bufr1_lg ! Data buffer
+ CHARACTER(LEN=6) :: bufr1_sm ! Data buffer
INTEGER, DIMENSION(DIM1) :: buf2 ! Data buffer
INTEGER, DIMENSION(DIM1) :: bufr2 ! Data buffer
REAL, DIMENSION(DIM1) :: buf3 ! Data buffer
@@ -1446,20 +1503,46 @@ SUBROUTINE test_attributes()
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
+
+ !
+ ! read attribute into a fortran character buf that is smaller then buf1.
+ !
+ CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1_sm,errcode)
+
+ !
+ ! compare read and write buffers.
+ !
+ IF ( buf1(1:6) .NE. bufr1_sm(1:6) ) THEN
+ PRINT *, 'smaller read buffer differs from write buffer'
+ PRINT *, buf1, ' and ', bufr1_sm
+ STOP
+ ENDIF
CALL passed()
generated by cgit v0.12 at 2024-12-26 15:14:14 (GMT)