Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Futility
Futility
Commits
4c13f7aa
Commit
4c13f7aa
authored
Sep 14, 2021
by
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
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
src/FileType_HDF5.f90
View file @
4c13f7aa
...
...
@@ -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 object
t
.'
)
' - 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
View file @
4c13f7aa
...
...
@@ -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
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment