Merge branch 'has_attribute' into 'master'

HDF5FileType has_attribute function

See merge request futility/Futility!350

src/FileType_HDF5.f90

@@ -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

unit_tests/testHDF5FileType/testHDF5FileType.f90

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