add get_strpad tests

Author: scivision

src/interface.f90

@@ -45,21 +45,23 @@ module h5mpi
 procedure, public :: shape => hdf_get_shape
 procedure, public :: layout => hdf_get_layout
 procedure, public :: chunks => hdf_get_chunk
-procedure, public :: exist => hdf_check_exist
 procedure, public :: class => get_class
 procedure, public :: dtype => get_native_dtype
 procedure, public :: deflate => get_deflate
+procedure, public :: exist => hdf_check_exist
 procedure, public :: is_contig => hdf_is_contig
 procedure, public :: is_chunked => hdf_is_chunked
 procedure, public :: is_compact => hdf_is_compact
+procedure, public :: get_strpad
 procedure, public :: softlink => create_softlink
 procedure, public :: is_open
 !! procedures without mapping
 
+!> below are procedure that need generic mapping (type or rank agnostic)
+
 generic, public :: write => h5write_scalar, h5write_1d, h5write_2d, h5write_3d, h5write_4d, h5write_5d, h5write_6d, h5write_7d
 
 generic, public :: read => h5read_scalar, h5read_1d, h5read_2d, h5read_3d, h5read_4d, h5read_5d, h5read_6d, h5read_7d
-!! mapped procedures
 
 !> write attributes
 generic, public :: writeattr => writeattr_char, writeattr_num
@@ -253,6 +255,11 @@ module subroutine h5open_read(self, dname, dims, dset_dims, filespace, memspace,
 integer(HID_T), intent(out) :: filespace, memspace, dset_id
 end subroutine h5open_read
 
+module integer function get_strpad(self, dset_name)
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: dset_name
+end function get_strpad
+
 module logical function get_deflate(self, dname)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname

src/read.f90

@@ -6,7 +6,7 @@
   h5pget_layout_f, h5pget_chunk_f, h5pclose_f, h5pget_nfilters_f, h5pget_filter_f, &
   h5dget_type_f, h5dopen_f, h5dclose_f, &
   h5lexists_f, &
-  h5tclose_f, h5tget_native_type_f, h5tget_class_f, H5Tget_order_f, h5tget_size_f, &
+  h5tclose_f, h5tget_native_type_f, h5tget_class_f, H5Tget_order_f, h5tget_size_f, h5tget_strpad_f, &
   h5z_filter_deflate_f, &
   H5T_DIR_ASCEND_F
 
@@ -35,12 +35,22 @@
 
 
 module procedure get_class
-
 call get_dset_class(self, dname, get_class)
-
 end procedure get_class
 
 
+module procedure get_strpad
+!! H5T_STR_NULLTERM  Null terminate (as C does).
+!! H5T_STR_NULLPAD   Pad with zeros.
+!! H5T_STR_SPACEPAD  Pad with spaces (as FORTRAN does).
+
+integer :: class
+
+call get_dset_class(self, dset_name, class, pad_type=get_strpad)
+
+end procedure get_strpad
+
+
 module procedure get_deflate
 !! h5pget_filter_f doesn't work collectively, will crash on h5fclose_f
 !! if(mpi_id==0) with mpi_bcast does not work, same crash.
@@ -61,6 +71,7 @@
 
 Naux = size(Aux, kind=SIZE_T)
 
+if(.not.self%exist(dname)) error stop "ERROR:h5fortran:get_deflate: " // dname // " does not exist: " // self%filename
 call h5dopen_f(self%file_id, dname, dset_id, ierr)
 if (ierr/=0) error stop "ERROR:h5fortran:get_deflate:h5dopen: " // dname // " in " // self%filename
 
@@ -99,40 +110,34 @@
 end procedure get_deflate
 
 
-subroutine get_dset_class(self, dname, class, ds_id, size_bytes)
+subroutine get_dset_class(self, dname, class, ds_id, size_bytes, pad_type)
 !! get the dataset class (integer, float, string, ...)
 !! {H5T_INTEGER_F, H5T_FLOAT_F, H5T_STRING_F}
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
 integer, intent(out) :: class
-integer(hid_t), intent(in), optional :: ds_id
-integer(size_t), intent(out), optional :: size_bytes
+integer(HID_T), intent(in), optional :: ds_id
+integer(SIZE_T), intent(out), optional :: size_bytes
+integer, intent(out), optional :: pad_type
 
 integer :: ierr
-integer(hid_t) :: dtype_id, native_dtype_id, dset_id
+integer(HID_T) :: dtype_id, native_dtype_id, dset_id
 
 if(present(ds_id)) then
   dset_id = ds_id
 else
+  if(.not.self%exist(dname)) error stop "ERROR:h5fortran:get_dset_class: " // dname // " does not exist: " // self%filename
+
   call h5dopen_f(self%file_id, dname, dset_id, ierr)
   if(ierr/=0) error stop 'ERROR:h5fortran:get_class: ' // dname // ' from ' // self%filename
 endif
 
 call h5dget_type_f(dset_id, dtype_id, ierr)
 if(ierr/=0) error stop 'ERROR:h5fortran:get_class: dtype_id ' // dname // ' from ' // self%filename
 
-if(.not.present(ds_id)) then
-  call h5dclose_f(dset_id, ierr)
-  if(ierr/=0) error stop 'ERROR:h5fortran:get_class: close dataset ' // dname // ' from ' // self%filename
-endif
-
 call h5tget_native_type_f(dtype_id, H5T_DIR_ASCEND_F, native_dtype_id, ierr)
 if(ierr/=0) error stop 'ERROR:h5fortran:get_class: native_dtype_id ' // dname // ' from ' // self%filename
 
-call h5tclose_f(dtype_id, ierr)
-if(ierr/=0) error stop 'ERROR:h5fortran:get_class: closing dtype ' // dname // ' from ' // self%filename
-
-
 !> compose datatype inferred
 call h5tget_class_f(native_dtype_id, class, ierr)
 if(ierr/=0) error stop 'ERROR:h5fortran:get_class: class ' // dname // ' from ' // self%filename
@@ -142,9 +147,25 @@ subroutine get_dset_class(self, dname, class, ds_id, size_bytes)
   if(ierr/=0) error stop 'ERROR:h5fortran:get_class: byte size ' // dname // ' from ' // self%filename
 endif
 
+if(present(pad_type)) then
+  if(class /= H5T_STRING_F) error stop "ERROR:h5fortran:get_class: pad_type only for string"
+
+  call H5Tget_strpad_f(dtype_id, pad_type, ierr)
+  if(ierr /= 0) error stop "h5fortran:read:h5tget_strpad " // dname // " in " // self%filename
+endif
+
+!> close to avoid memory leaks
 call h5tclose_f(native_dtype_id, ierr)
 if(ierr/=0) error stop 'ERROR:h5fortran:get_class: closing native dtype ' // dname // ' from ' // self%filename
 
+call h5tclose_f(dtype_id, ierr)
+if(ierr/=0) error stop 'ERROR:h5fortran:get_class: closing dtype ' // dname // ' from ' // self%filename
+
+if(.not.present(ds_id)) then
+  call h5dclose_f(dset_id, ierr)
+  if(ierr/=0) error stop 'ERROR:h5fortran:get_class: close dataset ' // dname // ' from ' // self%filename
+endif
+
 end subroutine get_dset_class
 
 
@@ -209,7 +230,6 @@ end subroutine get_dset_class
 
 
 module procedure hdf_get_shape
-
 !! must get rank before info, as "dims" must be allocated first.
 integer(SIZE_T) :: type_size
 integer :: type_class, drank, ier

src/read_scalar.f90

@@ -1,10 +1,10 @@
 submodule (h5mpi:hdf5_read) read_scalar
 
 use h5lt, only : h5ltread_dataset_string_f
-use hdf5, only : h5dread_f, h5dvlen_get_max_len_f, h5dread_vl_f, h5dvlen_reclaim_f,&
-h5tis_variable_str_f, h5tget_strpad_f, &
-H5T_STR_NULLTERM_F, &
-H5Dget_space_f, h5sclose_f
+use hdf5, only : h5dread_f, h5dget_space_f, h5dvlen_get_max_len_f, h5dread_vl_f, h5dvlen_reclaim_f,&
+h5tis_variable_str_f, &
+h5sclose_f, &
+H5T_STR_NULLTERM_F
 
 implicit none (type, external)
 

src/write.f90

@@ -195,6 +195,10 @@ subroutine set_deflate(self, dims, dcpl, chunk_size)
 dcpl = H5P_DEFAULT_F
 
 if (present(chunk_size)) then
+  if(size(chunk_size) /= size(dims)) then
+    write(stderr,*) "ERROR:h5fortran:write:set_deflate: chunk_size length ", size(chunk_size), " /= dims length ", size(dims)
+    error stop
+  endif
   cs = chunk_size
   where (cs > dims) cs = dims
   if(self%debug) print *,'TRACE: user request chunk_size ',cs

test/test_attributes.f90

@@ -33,7 +33,6 @@ program test_attributes
 
 contains
 
-
 subroutine test_write_attributes(path)
 
 type(hdf5_file) :: h

test/test_string.f90

@@ -4,7 +4,8 @@ program test_string
 
 use mpi, only : mpi_init, MPI_COMM_WORLD, mpi_comm_rank
 
-use h5mpi, only : hdf5_file
+use hdf5, only: H5T_STR_SPACEPAD_F
+use h5mpi, only: hdf5_file
 
 implicit none (type, external)
 
@@ -70,6 +71,9 @@ subroutine test_read(fn)
 endif
 if (value /= '42') error stop 'test_string:  read/write verification failure. Value: '// value
 
+!> check padding
+if (h%get_strpad("/little") /= H5T_STR_SPACEPAD_F) error stop "SPACEPAD expected for /little"
+
 !> longer character than data
 call h%read('/little', val1k)