add lt attr read/write and nompi attr test

Author: scivision

src/attr_read.f90

@@ -180,6 +180,27 @@ end subroutine readattr_char
 include 'attr_read.inc'
 end procedure
 
+module procedure lt0readattr
+
+type(hdf5_file) :: h
+
+call h%open(filename, action='r')
+call h%readattr(obj_name, attr, A)
+call h%close()
+
+end procedure lt0readattr
+
+
+module procedure lt1readattr
+
+type(hdf5_file) :: h
+
+call h%open(filename, action='r')
+call h%readattr(obj_name, attr, A)
+call h%close()
+
+end procedure lt1readattr
+
 
 subroutine get_attr_class(self, obj_name, attr_name, class, attr_id, size_bytes, pad_type)
 !! get the attribute class (integer, float, string, ...)

src/attr_write.f90

@@ -75,4 +75,26 @@
 end procedure
 
 
+module procedure lt0writeattr
+
+type(hdf5_file) :: h
+
+call h%open(filename, action='r+')
+call h%writeattr(obj_name, attr, A)
+call h%close()
+
+end procedure lt0writeattr
+
+
+module procedure lt1writeattr
+
+type(hdf5_file) :: h
+
+call h%open(filename, action='r+')
+call h%writeattr(obj_name, attr, A)
+call h%close()
+
+end procedure lt1writeattr
+
+
 end submodule attr_write

src/interface.f90

@@ -1,7 +1,7 @@
 module h5fortran
 
 use, intrinsic :: iso_c_binding, only : c_ptr, c_loc
-use, intrinsic :: iso_fortran_env, only : real32, real64, int32, int64, stderr=>error_unit
+use, intrinsic :: iso_fortran_env, only : real32, real64, int64, int32, stderr=>error_unit
 
 use hdf5, only : HID_T, SIZE_T, HSIZE_T, &
 H5S_ALL_F, H5S_SELECT_SET_F, &
@@ -31,8 +31,9 @@ module h5fortran
 !! compression level (1-9)  0: disable compression
 !! compression with MPI requires MPI-3 and HDF5 >= 1.10.2
 
-contains
 
+contains
+!> define methods (procedures) that don't need generic procedure
 procedure, public :: open => h5open
 procedure, public :: close => h5close
 procedure, public :: write_group
@@ -85,6 +86,16 @@ module h5fortran
 public :: hdf5_file, is_hdf5
 public :: hdf_rank_check, hdf_shape_check, hdf5version, h5exist, hdf5_close
 public :: mpi_collective, mpi_hyperslab
+public :: h5write_attr, h5read_attr
+
+interface h5write_attr
+procedure lt0writeattr, lt1writeattr
+end interface
+
+interface h5read_attr
+procedure lt0readattr, lt1readattr
+end interface
+
 
 !! for submodules only
 public :: HSIZE_T, H5T_NATIVE_REAL, H5T_NATIVE_DOUBLE, H5T_NATIVE_INTEGER, H5T_NATIVE_CHARACTER, H5T_STD_I64LE
@@ -436,6 +447,30 @@ module subroutine writeattr_7d(self, obj_name, attr, A)
 end subroutine
 
 
+module subroutine lt0writeattr(filename, obj_name, attr, A)
+character(*), intent(in) :: filename
+character(*), intent(in) :: obj_name, attr
+class(*), intent(in) :: A
+end subroutine
+
+module subroutine lt1writeattr(filename, obj_name, attr, A)
+character(*), intent(in) :: filename
+character(*), intent(in) :: obj_name, attr
+class(*), intent(in) :: A(:)
+end subroutine
+
+module subroutine lt0readattr(filename, obj_name, attr, A)
+character(*), intent(in) :: filename
+character(*), intent(in) :: obj_name, attr
+class(*), intent(inout) :: A
+end subroutine
+
+module subroutine lt1readattr(filename, obj_name, attr, A)
+character(*), intent(in) :: filename
+character(*), intent(in) :: obj_name, attr
+class(*), intent(inout) :: A(:)
+end subroutine
+
 module subroutine attr_delete(self, obj_name, attr_name)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: obj_name, attr_name

src/reader.f90

@@ -1,6 +1,6 @@
 submodule (h5fortran:hdf5_read) hdf5_reader
 
-use hdf5, only: h5dread_f, h5sclose_f
+use hdf5, only : h5dread_f, h5sclose_f
 
 implicit none (type, external)
 

src/write.f90

@@ -211,8 +211,6 @@ subroutine set_compact(dcpl, dset_dims, compact, dset_name)
 call h5pset_layout_f(dcpl, H5D_COMPACT_F, ierr)
 if (ierr /= 0) error stop "ERROR:h5fortran:hdf_create:h5pset_layout:set_compact"
 
-print *, "TRACE:h5fortran:set_compact: " // dset_name
-
 end subroutine set_compact
 
 

test/CMakeLists.txt

@@ -56,9 +56,9 @@ cmake_path(SET string_file ${CMAKE_CURRENT_BINARY_DIR}/test_string_py.h5)
 
 # --- non-MPI tests
 
-set(nompi_tests array)
+set(nompi_tests array attributes)
 
-nompi_test(${nompi_tests})
+nompi_test("${nompi_tests}")
 
 
 # --- runner
@@ -80,7 +80,7 @@ endif()
 
 # --- MPI tests
 
-set(mpi_tests array_mpi attributes cast destructor exist fill groups layout shape
+set(mpi_tests array_mpi attributes_mpi cast destructor exist fill groups layout shape
 string string_read write
 )
 

test/test_attributes.f90

@@ -1,35 +1,27 @@
 program test_attributes
 
 use, intrinsic:: iso_fortran_env, only: int32, real32, real64, stderr=>error_unit
-
-use h5fortran, only: hdf5_file
-use mpi, only : mpi_init, MPI_COMM_WORLD, mpi_comm_rank
+use h5fortran, only: hdf5_file, h5write_attr, h5read_attr
 
 implicit none (type, external)
 
-external :: mpi_finalize
-
 character(*), parameter :: filename = 'test_attr.h5'
-
-integer :: ierr, mpi_id
-
-call mpi_init(ierr)
-if (ierr /= 0) error stop "mpi_init"
-
-call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
-if (ierr /= 0) error stop "mpi_comm_rank"
-
+character(8) :: s32  !< arbitrary length
+integer :: i32(1)
 
 call test_write_attributes(filename)
-if(mpi_id == 0) print *,'PASSED: HDF5 write attributes'
+call h5write_attr(filename, '/x', 'str29', '29')
+call h5write_attr(filename, '/x', 'int29', [29])
+print *,'PASSED: HDF5 write attributes'
 
 call test_read_attributes(filename)
-if(mpi_id == 0) print *, 'PASSED: HDF5 read attributes'
-
+call h5read_attr(filename, '/x', 'str29', s32)
+if (s32 /= '29') error stop 'readattr_lt string'
 
-call mpi_finalize(ierr)
-if (ierr /= 0) error stop "mpi_finalize"
+call h5read_attr(filename, '/x', 'int29', i32)
+if (i32(1) /= 29) error stop 'readattr_lt integer'
 
+print *, 'PASSED: HDF5 read attributes'
 
 contains
 
@@ -40,7 +32,7 @@ subroutine test_write_attributes(path)
 
 integer :: i2(1,1), i3(1,1,1), i4(1,1,1,1), i5(1,1,1,1,1), i6(1,1,1,1,1,1), i7(1,1,1,1,1,1,1)
 
-call h%open(path, action='w', mpi=.true.)
+call h%open(path, action='w')
 
 call h%write('/x', 1)
 
@@ -59,7 +51,7 @@ subroutine test_write_attributes(path)
 
 call h%close()
 
-call h%open(path, action='a', mpi=.true.)
+call h%open(path, action='a')
 call h%writeattr('/x', 'int32-scalar', 142)
 call h%writeattr('/x', 'real32_1d', [real(real32) :: 142, 84])
 call h%writeattr('/x', 'char', 'overwrite attrs')
@@ -82,7 +74,7 @@ subroutine test_read_attributes(path)
 
 integer :: i2(1,1), i3(1,1,1), i4(1,1,1,1), i5(1,1,1,1,1), i6(1,1,1,1,1,1), i7(1,1,1,1,1,1,1)
 
-call h%open(path, action='r', mpi=.true.)
+call h%open(path, action='r')
 
 call h%read('/x', x)
 if (x/=1) error stop 'readattr: unexpected value'

test/test_attributes_mpi.f90

@@ -0,0 +1,114 @@
+program test_attributes
+
+use, intrinsic:: iso_fortran_env, only: int32, real32, real64, stderr=>error_unit
+
+use h5fortran, only: hdf5_file
+use mpi, only : mpi_init, MPI_COMM_WORLD, mpi_comm_rank
+
+implicit none (type, external)
+
+external :: mpi_finalize
+
+character(*), parameter :: filename = 'test_attr.h5'
+
+integer :: ierr, mpi_id
+
+call mpi_init(ierr)
+if (ierr /= 0) error stop "mpi_init"
+
+call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
+if (ierr /= 0) error stop "mpi_comm_rank"
+
+
+call test_write_attributes(filename)
+if(mpi_id == 0) print *,'PASSED: HDF5 write attributes'
+
+call test_read_attributes(filename)
+if(mpi_id == 0) print *, 'PASSED: HDF5 read attributes'
+
+call mpi_finalize(ierr)
+if (ierr /= 0) error stop "mpi_finalize"
+
+
+contains
+
+subroutine test_write_attributes(path)
+
+type(hdf5_file) :: h
+character(*), intent(in) :: path
+
+integer :: i2(1,1), i3(1,1,1), i4(1,1,1,1), i5(1,1,1,1,1), i6(1,1,1,1,1,1), i7(1,1,1,1,1,1,1)
+
+call h%open(path, action='w', mpi=.true.)
+
+call h%write('/x', 1)
+
+call h%writeattr('/x', 'int32-scalar', 42)
+call h%writeattr('/x', 'char','this is just a little number')
+call h%writeattr('/x', 'hello', 'hi')
+call h%writeattr('/x', 'real32_1d', [real(real32) :: 42, 84])
+call h%writeattr('/x', 'real64_1d0', [42._real64])
+
+call h%writeattr('/x', 'i2', i2)
+call h%writeattr('/x', 'i3', i3)
+call h%writeattr('/x', 'i4', i4)
+call h%writeattr('/x', 'i5', i5)
+call h%writeattr('/x', 'i6', i6)
+call h%writeattr('/x', 'i7', i7)
+
+call h%close()
+
+call h%open(path, action='a', mpi=.true.)
+call h%writeattr('/x', 'int32-scalar', 142)
+call h%writeattr('/x', 'real32_1d', [real(real32) :: 142, 84])
+call h%writeattr('/x', 'char', 'overwrite attrs')
+call h%delete_attr('/x', 'hello')
+call h%close()
+
+end subroutine test_write_attributes
+
+
+subroutine test_read_attributes(path)
+
+type(hdf5_file) :: h
+character(*), intent(in) :: path
+character(1024) :: attr_str
+integer :: int32_0
+real(real32) :: attr32(2)
+real(real64) :: attr64
+
+integer :: x
+
+integer :: i2(1,1), i3(1,1,1), i4(1,1,1,1), i5(1,1,1,1,1), i6(1,1,1,1,1,1), i7(1,1,1,1,1,1,1)
+
+call h%open(path, action='r', mpi=.true.)
+
+call h%read('/x', x)
+if (x/=1) error stop 'readattr: unexpected value'
+
+call h%readattr('/x', 'char', attr_str)
+if (attr_str /= 'overwrite attrs') error stop 'overwrite attrs failed: ' // attr_str
+
+call h%readattr('/x', 'int32-scalar', int32_0)
+if (int32_0 /= 142) error stop 'readattr: int32-scalar'
+
+call h%readattr('/x', 'real32_1d', attr32)
+if (any(attr32 /= [real(real32) :: 142, 84])) error stop 'readattr: real32'
+
+call h%readattr('/x', 'real64_1d0', attr64)
+if (attr64 /= 42._real64) error stop 'readattr: real64'
+
+if (h%exist_attr('/x', 'hello')) error stop "delete attr failed"
+
+call h%readattr('/x', 'i2', i2)
+call h%readattr('/x', 'i3', i3)
+call h%readattr('/x', 'i4', i4)
+call h%readattr('/x', 'i5', i5)
+call h%readattr('/x', 'i6', i6)
+call h%readattr('/x', 'i7', i7)
+
+call h%close()
+
+end subroutine test_read_attributes
+
+end program