Commit 4c13f7aa authored by Graham, Aaron's avatar Graham, Aaron
Browse files

Merge branch 'has_attribute' into 'master'

HDF5FileType has_attribute function

See merge request futility/Futility!350
parents 33ce2ab1 93997019
Pipeline #164082 passed with stage
in 2 minutes and 9 seconds
......@@ -442,38 +442,41 @@ TYPE,EXTENDS(BaseFileType) :: HDF5FileType
read_n6, read_n7, read_c1, read_pList
!> Generic typebound interface for pointer-based read operations
GENERIC :: freadp => read_dp4
!> @copybrief FileType_HDF5::has_attribute
!> @copydoc FileType_HDF5::has_attribute
PROCEDURE,PASS :: has_attribute
!> @copybrief FileType_HDF5::write_attribute_st0
!> @copydoc FileType_HDF5_write_attribute_st0
!> @copydoc FileType_HDF5::write_attribute_st0
PROCEDURE,PASS,PRIVATE :: write_attribute_st0
!> @copybrief FileType_HDF5::write_attribute_c0
!> @copydoc FileType_HDF5_write_attribute_c0
!> @copydoc FileType_HDF5::write_attribute_c0
PROCEDURE,PASS,PRIVATE :: write_attribute_c0
!> @copybrief FileType_HDF5::write_attribute_i0
!> @copydoc FileType_HDF5_write_attribute_i0
!> @copydoc FileType_HDF5::write_attribute_i0
PROCEDURE,PASS,PRIVATE :: write_attribute_i0
!> @copybrief FileType_HDF5::write_attribute_d0
!> @copydoc FileType_HDF5_write_attribute_d0
!> @copydoc FileType_HDF5::write_attribute_d0
PROCEDURE,PASS,PRIVATE :: write_attribute_d0
!> @copybrief FileType_HDF5::write_attribute_b0
!> @copydoc FileType_HDF5_write_attribute_b0
!> @copydoc FileType_HDF5::write_attribute_b0
PROCEDURE,PASS,PRIVATE :: write_attribute_b0
!> Generic typebound interface for all @c attribute writes
GENERIC :: write_attribute => write_attribute_st0, write_attribute_c0,&
write_attribute_i0, write_attribute_d0,write_attribute_b0
!> @copybrief FileType_HDF5::read_str_attribure_help
!> @copydoc FileType_HDF5_read_str_attribure_help
!> @copydoc FileType_HDF5::read_str_attribure_help
PROCEDURE,PASS,PRIVATE :: read_attribute_st0
!> @copybrief FileType_HDF5::read_attribute_c0
!> @copydoc FileType_HDF5_read_attribute_c0
!> @copydoc FileType_HDF5::read_attribute_c0
PROCEDURE,PASS,PRIVATE :: read_attribute_c0
!> @copybrief FileType_HDF5::read_attribute_i0
!> @copydoc FileType_HDF5_read_attribute_i0
!> @copydoc FileType_HDF5::read_attribute_i0
PROCEDURE,PASS,PRIVATE :: read_attribute_i0
!> @copybrief FileType_HDF5::read_attribute_d0
!> @copydoc FileType_HDF5_read_attribute_d0
!> @copydoc FileType_HDF5::read_attribute_d0
PROCEDURE,PASS,PRIVATE :: read_attribute_d0
!> @copybrief FileType_HDF5::read_attribute_b0
!> @copydoc FileType_HDF5_read_attribute_b0
!> @copydoc FileType_HDF5::read_attribute_b0
PROCEDURE,PASS,PRIVATE :: read_attribute_b0
!> Generic typebound interface for all @c attribute writes
GENERIC :: read_attribute => read_attribute_st0, read_attribute_c0,&
......@@ -6817,23 +6820,23 @@ SUBROUTINE preRead(thisHDF5File,path,rank,dset_id,dspace_id,dims,error)
! Open the dataset
CALL h5dopen_f(thisHDF5File%file_id, path, dset_id, error)
IF(error /= 0) CALL thisHDF5File%e%raiseError(modName//'::'//myName// &
' - Failed to open dataset.')
' - Failed to open dataset "'//path//'".')
! Get dataset dimensions for allocation
CALL h5dget_space_f(dset_id,dspace_id,error)
IF(error /= 0) CALL thisHDF5File%e%raiseError(modName//'::'//myName// &
' - Failed to obtain the dataspace.')
' - Failed to obtain the dataspace for dataset "'//path//'".')
! Make sure the rank is right
IF(rank > 0) THEN
CALL h5sget_simple_extent_ndims_f(dspace_id,ndims,error)
IF(error < 0) CALL thisHDF5File%e%raiseError(modName//'::'//myName// &
' - Failed to retrieve number of dataspace dimensions.')
' - Failed to retrieve number of dataspace dimensions for dataset "'//path//'".')
IF(ndims /= rank) CALL thisHDF5File%e%raiseError(modName//'::'//myName// &
' - Using wrong read function for rank.')
' - Using wrong read function for rank for dataset "'//path//'".')
CALL h5sget_simple_extent_dims_f(dspace_id,dims,maxdims,error)
IF(error < 0) CALL thisHDF5File%e%raiseError(modName//'::'//myName// &
' - Failed to retrieve dataspace dimensions.')
' - Failed to retrieve dataspace dimensions for dataset "'//path//'".')
ELSE
dims=1
ENDIF
......@@ -7096,8 +7099,44 @@ ENDSUBROUTINE createAttribute
#endif
!
!-------------------------------------------------------------------------------
!> @brief Writes an attribute name and string value to a known dataset
!> @brief Checks if a dataset has a named attribute
!> @param this the file to search
!> @param obj_name the relative path of the dataset
!> @param attr_name the name of the attribute to search for
!> @returns hasAttribute the result of the search
!>
FUNCTION has_attribute(this,obj_name,attr_name) RESULT(hasAttribute)
CLASS(HDF5FileType),INTENT(INOUT) :: this
CHARACTER(LEN=*),INTENT(IN) :: obj_name
CHARACTER(LEN=*),INTENT(IN) :: attr_name
LOGICAL(SBK) :: hasAttribute
#ifdef FUTILITY_HAVE_HDF5
CHARACTER(LEN=*),PARAMETER :: myname='has_attribute'
INTEGER(HID_T) :: obj_id,attr_id
REQUIRE(this%isInit)
hasAttribute=.FALSE.
CALL open_object(this,obj_name,obj_id,error)
IF(error /= 0) THEN
CALL this%e%raiseError(modName//'::'//myName//' - dataset "'//obj_name// &
'" could not be found while searching for attribute "'//attr_name//'"!')
RETURN
ENDIF
CALL open_attribute(this,obj_id,attr_name,attr_id,error)
hasAttribute = (error == 0)
IF(hasAttribute) THEN
CALL close_attribute(this,attr_id)
ENDIF
CALL close_object(this,obj_id)
#endif
ENDFUNCTION has_attribute
!
!-------------------------------------------------------------------------------
!> @brief Writes an attribute name and string value to a known dataset
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7142,7 +7181,7 @@ ENDSUBROUTINE write_attribute_st0
!
!-------------------------------------------------------------------------------
!> @brief Writes an attribute name and string value to a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7161,7 +7200,7 @@ END SUBROUTINE write_attribute_c0
!
!-------------------------------------------------------------------------------
!> @brief Writes an attribute name and integer value to a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7198,7 +7237,7 @@ ENDSUBROUTINE write_attribute_i0
!
!-------------------------------------------------------------------------------
!> @brief Writes an attribute name and real value to a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7235,7 +7274,7 @@ ENDSUBROUTINE write_attribute_d0
!
!-------------------------------------------------------------------------------
!> @brief Writes an attribute name and logical value to a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7261,7 +7300,7 @@ SUBROUTINE write_attribute_b0(this,obj_name,attr_name,attr_val)
CALL h5screate_simple_f(num_dims,dims,dspace_id,error)
!Create and write to the attribute within the dataspce
char_attr_val = MERGE('T','F',attr_val)
char_attr_val = MERGE('T','F',attr_val)
CALL createAttribute(this,obj_id,attr_name,H5T_NATIVE_CHARACTER,&
dspace_id,attr_id)
CALL h5awrite_f(attr_id,H5T_NATIVE_CHARACTER,char_attr_val,dims,error)
......@@ -7274,7 +7313,7 @@ ENDSUBROUTINE write_attribute_b0
!
!-------------------------------------------------------------------------------
!> @brief Set-up to read a string value attribute from a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7302,7 +7341,7 @@ ENDSUBROUTINE read_attribute_st0
!
!-------------------------------------------------------------------------------
!> @brief Set-up to read a string value attribute from a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7321,7 +7360,7 @@ ENDSUBROUTINE read_attribute_c0
!
!-------------------------------------------------------------------------------
!> @brief Reads a string value attribute from a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7345,7 +7384,7 @@ ENDSUBROUTINE read_attribute_st0_helper
!
!-------------------------------------------------------------------------------
!> @brief Reads a integer value attribute from a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7378,7 +7417,7 @@ ENDSUBROUTINE read_attribute_i0
!
!-------------------------------------------------------------------------------
!> @brief Reads a double value attribute from a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7412,7 +7451,7 @@ ENDSUBROUTINE read_attribute_d0
!
!-------------------------------------------------------------------------------
!> @brief Reads a logical value attribute from a known dataset
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param attr_name the desired name of the attribute
!> @param attr_value the desired value of the attrbute
......@@ -7455,15 +7494,22 @@ ENDSUBROUTINE read_attribute_b0
!
!-------------------------------------------------------------------------------
!> @brief Sets up all attribute operations by checking links and opening object`
!>
!> @param this the file to read
!> @param obj_name the relative path to the dataset
!> @param obj_id the HDF5 system id for the working dataset
!> @param ioerror optional error flag to return
!>
!> If an error is encountered and @c ioerror is present, a non-zero value will
!> be set to it and returned. If an error is encountered and @c ioerror is not
!> present, the code will error out. If no error is encountered, @c ioerror
!> will be set to 0 if present.
!>
#ifdef FUTILITY_HAVE_HDF5
SUBROUTINE open_object(this,obj_name,obj_id)
SUBROUTINE open_object(this,obj_name,obj_id,ioerror)
CHARACTER(LEN=*),PARAMETER :: myName='open_object_HDF5FileType'
CLASS(HDF5FileType),INTENT(INOUT) :: this
CHARACTER(LEN=*),INTENT(IN) :: obj_name
INTEGER(SIK),INTENT(OUT),OPTIONAL :: ioerror
INTEGER(HID_T),INTENT(OUT) :: obj_id
CHARACTER(LEN=LEN(obj_name)+1) :: path
......@@ -7475,23 +7521,29 @@ SUBROUTINE open_object(this,obj_name,obj_id)
!Check for expected links between object, and File
CALL h5lexists_f(this%file_id,path,dset_exists,error)
IF(.NOT. dset_exists) THEN
CALL this%e%raiseError(modName//'::'//myName// &
' - Incorrect path to object.')
IF(PRESENT(ioerror)) THEN
ioerror=-1
ELSE
CALL this%e%raiseError(modName//'::'//myName//' - Incorrect path to object.')
ENDIF
RETURN
ENDIF
!Open the object
CALL h5Oopen_f(this%file_id,path,obj_id,error)
IF(error /= 0) THEN
CALL this%e%raiseError(modName//'::'//myName// &
' - Failed to open object.')
IF(PRESENT(ioerror)) THEN
ioerror=error
ELSE
CALL this%e%raiseError(modName//'::'//myName//' - Failed to open object.')
ENDIF
RETURN
ENDIF
ENDSUBROUTINE open_object
!
!-------------------------------------------------------------------------------
!> @brief closes all attribute operations by closing attribute
!>
!> @param this the file to read
!> @param attr_id the HDF5 system id for the working attribute
!> @param obj_id the HDF5 system id for the working object
!>
......@@ -7503,14 +7555,14 @@ SUBROUTINE close_attribute(this,attr_id)
CALL h5aclose_f(attr_id,error)
IF (error /= 0) THEN
CALL this%e%raiseError(modName//'::'//myName// &
' - Failed to close objectt.')
' - Failed to close attribute.')
RETURN
ENDIF
ENDSUBROUTINE close_attribute
!
!-------------------------------------------------------------------------------
!> @brief closes all group, dataset, datatype objects
!>
!> @param this the file to read
!> @param attr_id the HDF5 system id for the working attribute
!> @param obj_id the HDF5 system id for the working object
!>
......@@ -7522,7 +7574,7 @@ SUBROUTINE close_object(this,obj_id)
CALL h5Oclose_f(obj_id,error)
IF (error /= 0) THEN
CALL this%e%raiseError(modName//'::'//myName// &
' - Failed to close objectt.')
' - Failed to close object.')
RETURN
ENDIF
ENDSUBROUTINE close_object
......@@ -7530,15 +7582,22 @@ ENDSUBROUTINE close_object
!-------------------------------------------------------------------------------
!> @brief sets up the attribute wrting general operation by checking existance
!> and opening the attribute
!>
!> @param this the file to read
!> @param attr_id the HDF5 system id for the working attribute
!> @param attr_name the desired name of the attribute
!> @param obj_id the HDF5 system id for the working object
!> @param ioerror optional error flag to return
!>
!> If an error is encountered and @c ioerror is present, a non-zero value will
!> be set to it and returned. If an error is encountered and @c ioerror is not
!> present, the code will error out. If no error is encountered, @c ioerror
!> will be set to 0 if present.
!>
SUBROUTINE open_attribute(this,obj_id,attr_name,attr_id)
SUBROUTINE open_attribute(this,obj_id,attr_name,attr_id,ioerror)
CHARACTER(LEN=*),PARAMETER :: myName='open_attribute_rHDF5FileType'
CLASS(HDF5FileType),INTENT(INOUT) :: this
CHARACTER(LEN=*),INTENT(IN) :: attr_name
INTEGER(SIK),INTENT(OUT),OPTIONAL :: ioerror
INTEGER(HID_T),INTENT(IN) :: obj_id
INTEGER(HID_T),INTENT(OUT) :: attr_id
......@@ -7547,16 +7606,22 @@ SUBROUTINE open_attribute(this,obj_id,attr_name,attr_id)
!Check that the named attribute exists
CALL h5aexists_f(obj_id,attr_name,attr_exists,error)
IF (.NOT. attr_exists) THEN
CALL this%e%raiseError(modName//'::'//myName// &
' - Attribute does not exist for object.')
IF(PRESENT(ioerror)) THEN
ioerror=-1
ELSE
CALL this%e%raiseError(modName//'::'//myName//' - Attribute does not exist for object.')
ENDIF
RETURN
ENDIF
!Open the Attribute
CALL h5aopen_f(obj_id,attr_name,attr_id,error)
IF(error /= 0) THEN
CALL this%e%raiseError(modName//'::'//myName// &
' - Failed to open attribute.')
IF(PRESENT(ioerror)) THEN
ioerror=error
ELSE
CALL this%e%raiseError(modName//'::'//myName//' - Failed to open attribute.')
ENDIF
RETURN
ENDIF
ENDSUBROUTINE open_attribute
......
......@@ -2266,6 +2266,17 @@ SUBROUTINE testHDF5FileTypeRead()
CALL h5%fread('groupC->memC1',testC1)
ASSERT_EQ(testC1,refC1,'C1 Read Failure')
!Test for attribute existence
COMPONENT_TEST('%has_attribute')
ASSERT(h5%has_attribute('groupB->memB0',integer_name),'integer existence fail')
ASSERT(h5%has_attribute('groupB->memB1',string_name),'string existence fail')
ASSERT(h5%has_attribute('groupB->memB1',char_name),'char existence fail')
ASSERT(h5%has_attribute('groupB->memB2',real_name),'real existence fail')
ASSERT(.NOT.h5%has_attribute('groupB->memB0',integer_name//' test'),'integer existence fail')
ASSERT(.NOT.h5%has_attribute('groupB->memB1',string_name//' test'),'string existence fail')
ASSERT(.NOT.h5%has_attribute('groupB->memB1',char_name//' test'),'char existence fail')
ASSERT(.NOT.h5%has_attribute('groupB->memB2',real_name//' test'),'real existence fail')
!Read test attributes
COMPONENT_TEST('%read_attributes')
!READ ATTRIBUTES
......@@ -2274,9 +2285,9 @@ SUBROUTINE testHDF5FileTypeRead()
CALL h5%read_attribute('groupB->memB1',string_name,testST0)
ASSERT_EQ(CHAR(refST0),CHAR(testST0),'string read fail')
CALL h5%read_attribute('groupB->memB1',char_name,testC1)
ASSERT_EQ(refC1,testC1,'string read fail')
ASSERT_EQ(refC1,testC1,'char read fail')
CALL h5%read_attribute('groupB->memB2',real_name,testD0)
ASSERT_EQ(refD0,testD0,'real_read fail')
ASSERT_EQ(refD0,testD0,'real read fail')
COMPONENT_TEST('%fread to parameter list')
CALL h5%fread('groupC',tmpPL)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment