attributes:character: allow writing empty character

fixes #44

Co-authored-by: gtokic <gtokic@users.noreply.github.com>

Author: scivision

CMakeLists.txt

@@ -12,7 +12,7 @@ endif()
 
 project(h5fortran
 LANGUAGES C Fortran
-VERSION 4.10.2
+VERSION 4.10.3
 )
 
 include(CTest)

src/attr.f90

@@ -30,6 +30,7 @@ subroutine attr_create(self, obj_name, attr_name, dtype, attr_dims, attr_id, dty
 
 if(dtype == H5T_NATIVE_CHARACTER) then
   if(.not. present(charlen)) error stop "ERROR:h5fortran:attr_create: character type must specify charlen"
+  if (charlen < 1) error stop "ERROR:h5fortran:attr_create: character type must specify charlen > 0"
 
   call H5Tset_size_f(dtype_id, int(charlen, SIZE_T), ier)
   call estop(ier, "attr_create:H5Aset_size", self%filename, obj_name, attr_name)

src/attr_write.inc

@@ -20,6 +20,7 @@ type is (integer(int64))
 type is(character(*))
   dtype = H5T_NATIVE_CHARACTER
   charlen = len(A)  !< workaround for GCC 8.3.0 bug
+  if(charlen == 0) charlen = 1 !< empty string is OK but charlen is strictly positive.
 class default
   error stop "ERROR:h5fortran:writeattr: unknown dataset type for " // obj_name // ":" // attr // " in " // self%filename
 end select

src/read_ascii.f90

@@ -90,9 +90,12 @@ elemental function pad_trim(s) result(t)
 
 i = index(s, C_NULL_CHAR) - 1
 if (i < 0) i = len_trim(s)
-if (i == 0) i = 1
 
-t = s(:i)
+if (i > 0) then
+  t = s(1:i)
+else
+  t = ""
+endif
 
 end function pad_trim
 

test/test_attributes.f90

@@ -1,6 +1,7 @@
 program test_attributes
 
 use, intrinsic:: iso_fortran_env, only: int32, real32, real64, stderr=>error_unit
+use, intrinsic:: iso_c_binding
 
 use h5fortran, only: hdf5_file, h5write_attr, h5read_attr, HSIZE_T
 
@@ -35,7 +36,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')
+call h%open(path, action='w', debug=.true.)
 
 call h%write('/x', 1)
 
@@ -55,9 +56,11 @@ subroutine test_write_attributes(path)
 
 call h%writeattr("/x", "c1d", [character(5) :: 'one', 'two', 'three'])
 call h%writeattr("/x", "c2d", reshape([character(5) :: 'one', 'two', 'three', 'four', 'five', 'six'], [2,3]))
+call h%writeattr("/x", "empty_char", "")
 
 call h%close()
 
+!> test overwrite of attributes
 call h%open(path, action='a')
 call h%writeattr('/x', 'int32-scalar', 142)
 call h%writeattr('/x', 'real32_1d', [real(real32) :: 142, 84])
@@ -89,9 +92,19 @@ subroutine test_read_attributes(path)
 call h%read('/x', x)
 if (x/=1) error stop 'readattr: unexpected value'
 
+!> character scalar
 call h%readattr('/x', 'char', attr_str)
 if (attr_str /= 'overwrite attrs') error stop 'overwrite attrs failed: ' // attr_str
 
+call h%readattr("/x", "empty_char", attr_str)
+print *, trim(attr_str) == c_null_char
+if (len_trim(attr_str) /= 0) then
+    write(stderr, '(a,i0)') "empty char attribute: expected 0 length, got length: ", len_trim(attr_str)
+    error stop "empty char attribute failed"
+endif
+if (trim(attr_str) /= "") error stop "empty char attribute failed, got: " // trim(attr_str)
+
+!> scalar numbers
 call h%readattr('/x', 'int32-scalar', int32_0)
 if (int32_0 /= 142) error stop 'readattr: int32-scalar'
 
@@ -117,6 +130,8 @@ subroutine test_read_attributes(path)
 call h%readattr('/x', 'i6', i6)
 call h%readattr('/x', 'i7', i7)
 
+!> character array
+
 call h%shape("/x", dims, "c1d")
 if(dims(1) /= 3) error stop "attr % shape: c1d"