Commit 93997019 authored by Graham, Aaron's avatar Graham, Aaron
Browse files

Adds a query function to determine if a particular attribute is present or not

Also cleans up some documentation and improves some error messages
parent 33ce2ab1
Loading
Loading
Loading
Loading
+108 −43
Original line number Diff line number Diff line
@@ -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
@@ -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
+13 −2
Original line number Diff line number Diff line
@@ -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)