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

src/FileType_HDF5.f90

+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

unit_tests/testHDF5FileType/testHDF5FileType.f90

+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)