add %softlink create, h5exist() fcn and tests

Author: scivision

src/interface.f90

@@ -54,6 +54,7 @@ module h5mpi
 create => hdf_create, filesize => hdf_filesize, &
 class => get_class, dtype => get_native_dtype, &
 deflate => get_deflate, &
+softlink => create_softlink, &
 layout => hdf_get_layout, chunks => hdf_get_chunk, &
 is_contig => hdf_is_contig, is_chunked => hdf_is_chunked, is_compact => hdf_is_compact, &
 is_open
@@ -84,7 +85,7 @@ module h5mpi
 private
 public :: mpi_h5comm, hdf5_file, mpi_tags, has_parallel_compression, is_hdf5, &
 check, hdf_rank_check, hdf_shape_check, mpi_collective, mpi_hyperslab, &
-hdf5version, &
+hdf5version, h5exist, &
 HSIZE_T, &
 H5T_INTEGER_F, H5T_FLOAT_F, H5T_STRING_F, &
 H5T_NATIVE_REAL, H5T_NATIVE_DOUBLE, H5T_NATIVE_INTEGER, H5T_NATIVE_CHARACTER, H5T_STD_I64LE
@@ -102,6 +103,13 @@ module subroutine hdf_create(self, dname, dtype, mem_dims, dset_dims, filespace,
 integer, dimension(:), intent(in), optional :: chunk_size
 logical, intent(in), optional :: compact
 end subroutine hdf_create
+
+module subroutine create_softlink(self, tgt, link)
+class(hdf5_file), intent(inout) :: self
+character(*), intent(in) :: tgt, &  !< target path to link
+                            link  !< soft link path to create
+end subroutine create_softlink
+
 end interface
 
 interface !< hdf5_config.f90
@@ -249,6 +257,12 @@ end subroutine hdf_get_chunk
 !! the read "value" are intent(inout) because:
 !! * arrays: to work correctly when actual argument is allocatable
 !! * scalar: to work correctly with character type
+
+module logical function h5exist(filename, dname, mpi)
+character(*), intent(in) :: filename, dname
+logical, intent(in) :: mpi
+end function h5exist
+
 module subroutine h5read_scalar(self, dname, value)
 class(hdf5_file), intent(in)     :: self
 character(*), intent(in)         :: dname

src/read/reader.in.f90

@@ -5,6 +5,17 @@
 contains
 
 
+module procedure h5exist
+
+type(hdf5_file) :: h
+
+call h%open(filename, action='r', mpi=mpi)
+h5exist = h%exist(dname)
+call h%close()
+
+end procedure h5exist
+
+
 module procedure h5read_scalar
 
 integer(HSIZE_T) :: dims(0)

src/tests/unit/CMakeLists.txt

@@ -5,7 +5,7 @@ max_gcd(${MPI_MAX} ${MPIEXEC_MAX_NUMPROCS} Nmpi)
 
 message(STATUS "Unit tests using ${Nmpi} processes")
 
-set(test_names cast deflate_write deflate_props deflate_read destructor layout shape string)
+set(test_names cast deflate_write deflate_props deflate_read destructor exist layout shape string)
 
 foreach(t IN LISTS test_names)
 

src/tests/unit/test_exist.f90

@@ -0,0 +1,134 @@
+program exist_tests
+!! test "exist" variable
+
+use, intrinsic :: iso_fortran_env, only : stderr=>error_unit
+
+use mpi, only : mpi_init, MPI_COMM_WORLD, mpi_comm_rank
+
+use h5mpi, only: hdf5_file, h5exist, is_hdf5
+
+
+implicit none (type, external)
+
+external :: mpi_finalize
+
+integer :: ierr, mpi_id
+character(*), parameter :: fn = "test_destruct.h5"
+
+
+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_is_hdf5()
+if(mpi_id == 0) print *, 'OK: is_hdf5'
+
+call test_exist('exist.h5')
+if(mpi_id == 0) print *, 'OK: exist'
+
+call test_softlink('soft.h5')
+if(mpi_id == 0) print *, "OK: softlink"
+
+call test_multifiles()
+if(mpi_id == 0) print *, 'OK: multiple files open at once'
+
+call mpi_finalize(ierr)
+if (ierr /= 0) error stop "mpi_finalize"
+
+
+contains
+
+
+subroutine test_is_hdf5()
+integer :: i
+
+if(is_hdf5('apidfjpj-8j9ejfpq984jfp89q39SHf.h5')) error stop 'test_exist: non-existent file declared hdf5'
+
+open(newunit=i, file='not_hdf5.h5', action='write')
+write(i,*) 'I am not an HDF5 file.'
+close(i)
+
+if(is_hdf5('not_hdf5.h5')) error stop 'text files are not hdf5'
+
+end subroutine test_is_hdf5
+
+
+subroutine test_exist(fn)
+
+type(hdf5_file) :: h
+
+character(*), intent(in) :: fn
+
+call h%open(fn, "w", mpi=.true.)
+call h%write('/x', 42)
+call h%close()
+
+if(.not.is_hdf5(fn)) error stop fn // ' does not exist'
+
+call h%open(fn, "r", mpi=.true.)
+if (.not. h%exist('/x')) error stop fn // ' /x exists'
+
+if (h%exist('/A')) error stop 'variable /A should not exist in ' // fn
+
+call h%close()
+
+if(h%is_open()) error stop 'file is closed'
+
+if (.not. h5exist(fn, '/x', mpi=.true.)) error stop 'x exists'
+if (h5exist(fn, '/A', mpi=.true.)) error stop 'A not exist'
+
+end subroutine test_exist
+
+
+subroutine test_softlink(fn)
+
+type(hdf5_file) :: h
+character(*), intent(in) :: fn
+
+integer :: y
+
+call h%open(fn, action='w', mpi=.true.)
+
+call h%write("/actual", 142)
+call h%softlink("/actual", "/additional")
+call h%read("/additional", y)
+
+if (.not.h%exist("/additional")) error stop "softlink not present"
+
+if (y /= 142) error stop "did not read softlink correctly"
+
+!> test dangling link
+
+call h%softlink("/not_here", "/not_yet")
+if (h%exist("/not_yet")) error stop "dangling softlink"
+
+call h%write("/not_here", 36)
+call h%read("/not_yet", y)
+if (y /= 36)  error stop "finalizing dangling link failed"
+
+call h%close()
+
+end subroutine test_softlink
+
+
+subroutine test_multifiles()
+
+type(hdf5_file) :: f,g,h
+
+call f%open(filename='A.h5', action='w', mpi=.true.)
+call g%open(filename='B.h5', action='w', mpi=.true.)
+if (h%is_open()) error stop 'is_open not isolated at constructor'
+call h%open(filename='C.h5', action='w', mpi=.true.)
+
+call f%flush()
+
+call f%close()
+if (.not.g%is_open() .or. .not. h%is_open()) error stop 'is_open not isolated at destructor'
+call g%close()
+call h%close()
+
+end subroutine test_multifiles
+
+end program

src/write/write.f90

@@ -2,6 +2,7 @@
 
 use hdf5, only : h5pset_deflate_f, h5pset_fletcher32_f, h5pset_shuffle_f, h5pset_layout_f, &
 h5dwrite_f, &
+h5lcreate_soft_f, &
 h5screate_f, &
 H5S_SCALAR_F
 
@@ -98,6 +99,19 @@
 end procedure hdf_create
 
 
+module procedure create_softlink
+!! HDF5 soft link -- to variables in same file
+!! target need not exist (dangling link)
+!! linking to external files requires an external link (different function required)
+
+integer :: ierr
+
+call H5Lcreate_soft_f(tgt, self%file_id, link, ierr)
+if (ierr /= 0) error stop 'ERROR:h5fortran:create_softlink: ' // link // ' in ' // self%filename
+
+end procedure create_softlink
+
+
 subroutine set_deflate(self, dims, dcpl, chunk_size)
 class(hdf5_file), intent(in) :: self
 integer(HSIZE_T), intent(in) :: dims(:)