io: enhance delimiter handling in loadtxt and savetxt functions

Author: zoziha

src/stdlib_io.fypp

@@ -59,13 +59,15 @@ module stdlib_io
     !> Format string for quadruple precision real numbers
     FMT_REAL_QP = '(es44.35e4)', &
     !> Format string for single precision complex numbers
-    FMT_COMPLEX_SP = '(es15.8e2,1x,es15.8e2)', &
+    FMT_COMPLEX_SP = '(es15.08e2,1x,es15.08e2)', &
     !> Format string for double precision complex numbers
     FMT_COMPLEX_DP = '(es24.16e3,1x,es24.16e3)', &
     !> Format string for extended double precision complex numbers
     FMT_COMPLEX_XDP = '(es26.18e3,1x,es26.18e3)', &
     !> Format string for quadruple precision complex numbers
     FMT_COMPLEX_QP = '(es44.35e4,1x,es44.35e4)'
+  !> Default delimiter for loadtxt, savetxt and number_of_columns
+  character(len=1), parameter :: delimiter_default = " "
 
   public :: FMT_INT, FMT_REAL_SP, FMT_REAL_DP, FMT_REAL_XDP, FMT_REAL_QP
   public :: FMT_COMPLEX_SP, FMT_COMPLEX_DP, FMT_COMPLEX_XDP, FMT_COMPLEX_QP
@@ -143,9 +145,9 @@ contains
       !!     11 12 13
       !!     ...
       !!
-      character(len=1), parameter :: delimiter_default = " "
       integer :: s
-      integer :: nrow, ncol, i, ios, skiprows_, max_rows_
+      integer :: nrow, ncol, i, j, ios, skiprows_, max_rows_, istart, iend
+      character(len=:), allocatable :: line, iomsg_
       character(len=1024) :: iomsg, msgout
 
       skiprows_ = max(optval(skiprows, 0), 0)
@@ -163,10 +165,11 @@ contains
       ncol = 0
       if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_, delimiter=delimiter_)
       #:if 'complex' in t1
-      if (is_blank(delimiter_)) ncol = ncol / 2
+      ncol = ncol / 2
       #:endif
 
       allocate(d(max_rows_, ncol))
+      if (max_rows_ == 0 .or. ncol == 0) return
 
       do i = 1, skiprows_
         read(s, *, iostat=ios, iomsg=iomsg)
@@ -190,15 +193,44 @@ contains
 
       if ( fmt_ == '*' ) then
         ! Use list directed read if user has specified fmt='*'
-        do i = 1, max_rows_
-          read (s,*,iostat=ios,iomsg=iomsg) d(i, :)
-          
-          if (ios/=0) then 
-             write(msgout,2) trim(iomsg),size(d,2),i,trim(filename)
-             call error_stop(msg=trim(msgout))
-          end if          
-          
-        enddo
+        if (is_blank(delimiter_) .or. delimiter_ == ",") then
+          do i = 1, max_rows_
+            read (s,*,iostat=ios,iomsg=iomsg) d(i, :)
+            
+            if (ios/=0) then 
+              write(msgout,2) trim(iomsg),size(d,2),i,trim(filename)
+              call error_stop(msg=trim(msgout))
+            end if          
+            
+          enddo
+        ! Otherwise read each value separately
+        else
+          do i = 1, max_rows_
+            call get_line(s, line, ios, iomsg_)
+            if (ios/=0) then 
+               write(msgout,2) trim(iomsg_),size(d,2),i,trim(filename)
+               call error_stop(msg=trim(msgout))
+            end if
+  
+            istart = 0
+            do j = 1, ncol - 1
+              iend = index(line(istart+1:), delimiter_)
+              read (line(istart+1:istart+iend-1),*,iostat=ios,iomsg=iomsg) d(i, j)
+              if (ios/=0) then 
+                 write(msgout,2) trim(iomsg),size(d,2),i,trim(filename)
+                 call error_stop(msg=trim(msgout))
+              end if
+              istart = istart + iend
+            end do
+  
+            read (line(istart+1:),*,iostat=ios,iomsg=iomsg) d(i, ncol)
+            if (ios/=0) then 
+               write(msgout,2) trim(iomsg),size(d,2),i,trim(filename)
+               call error_stop(msg=trim(msgout))
+            end if          
+            
+          enddo
+        end if
       else
         ! Otherwise pass default or user specified fmt string.
         do i = 1, max_rows_
@@ -241,7 +273,6 @@ contains
       !! call savetxt("log.txt", data)
       !!```
       !!
-      character(len=1), parameter :: delimiter_default = " "
       integer :: s, i, ios
       character(len=1) :: delimiter_
       character(len=3) :: delim_str
@@ -253,7 +284,7 @@ contains
       #:if 'real' in t1
         fmt_ = "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,"//delim_str//"))"
       #:elif 'complex' in t1
-        fmt_ = "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,"//delim_str//"))"
+        fmt_ = "(*"//FMT_COMPLEX_${k1}$(1:11)//delim_str//FMT_COMPLEX_${k1}$(14:23)//",:,"//delim_str//"))"
       #:elif 'integer' in t1
         fmt_ = "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,"//delim_str//"))"
       #:endif
@@ -289,7 +320,6 @@ contains
     integer, intent(in), optional :: skiprows
     character(len=1), intent(in), optional :: delimiter
 
-    character(len=1), parameter :: delimiter_default = " "
     integer :: ios, skiprows_, i
     character :: c
     character(len=:), allocatable :: line

test/io/test_loadtxt.f90

@@ -49,7 +49,11 @@ subroutine test_loadtxt_int32(error)
             if (allocated(error)) return
             call savetxt('test_int32.txt', input, delimiter=',')
             call loadtxt('test_int32.txt', expected, delimiter=',')
-            call check(error, all(input == expected),'User specified delimiter read failed')
+            call check(error, all(input == expected),'User specified delimiter `,` read failed')
+            if (allocated(error)) return
+            call savetxt('test_int32.txt', input, delimiter='-')
+            call loadtxt('test_int32.txt', expected, delimiter='-')
+            call check(error, all(input == expected),'User specified delimiter `-` read failed')
             if (allocated(error)) return
         end do
 
@@ -80,7 +84,11 @@ subroutine test_loadtxt_sp(error)
             if (allocated(error)) return
             call savetxt('test_sp.txt', input, delimiter=',')
             call loadtxt('test_sp.txt', expected, delimiter=',')
-            call check(error, all(input == expected),'User specified delimiter read failed')
+            call check(error, all(input == expected),'User specified delimiter `,` read failed')
+            if (allocated(error)) return
+            call savetxt('test_sp.txt', input, delimiter=';')
+            call loadtxt('test_sp.txt', expected, delimiter=';')
+            call check(error, all(input == expected),'User specified delimiter `;` read failed')
             if (allocated(error)) return
         end do
 
@@ -288,6 +296,10 @@ subroutine test_loadtxt_complex(error)
             call loadtxt('test_complex.txt', expected, delimiter=',')
             call check(error, all(input == expected))
             if (allocated(error)) return
+            call savetxt('test_complex.txt', input, delimiter=';')
+            call loadtxt('test_complex.txt', expected, delimiter=';')
+            call check(error, all(input == expected))
+            if (allocated(error)) return
         end do
 
     end subroutine test_loadtxt_complex