loadtxt format update

Update read loop structure.  Added optval formatting.  Additional messages added to test cases to better understand which read type failed.

Author: chuckyvt

src/stdlib_io.fypp

@@ -100,7 +100,8 @@ contains
       !! A value of zero results in no lines to be read.
       !! The default value is -1.
       integer, intent(in), optional :: max_rows
-      character(len=*), optional :: fmt
+      character(len=*), intent(in), optional :: fmt
+      character(len=:), allocatable :: fmt_
       !!
       !! Example
       !! -------
@@ -144,39 +145,52 @@ contains
         read(s, *)
       end do
 
-      do i = 1, max_rows_
-        #:if 'real' in t1
-        if ( present( fmt ) ) then
-          if ( fmt == '*' ) then
-            read (s,*) d(i, :)
-          else
-            read (s,fmt) d(i, :)
-          endif
-        else 
-          read (s,"(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
-        end if
-        #:elif 'complex' in t1
-        if ( present( fmt ) ) then
-          if ( fmt == '*' ) then
-            read (s,*) d(i, :)
-          else
-            read (s,fmt) d(i, :)
-          endif
-        else 
-          read(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :)
-        end if
-        #:else
-        if ( present( fmt ) ) then
-          if ( fmt == '*' ) then
-            read (s,*) d(i, :)
-          else
-            read (s,fmt) d(i, :)
-          endif
-        else 
-          read(s, *) d(i, :)
-        end if
-        #:endif
-      end do
+      #:if 'real' in t1
+      ! Default to format used for savetxt if fmt not specified.
+      fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))")
+
+      if ( fmt_ == '*' ) then
+        ! Use list directed read if user has specified fmt='*'
+        do i = 1, max_rows_
+          read (s,*) d(i, :)
+        enddo
+      else
+        ! Otherwise pass default or user specified fmt string.  
+        do i = 1, max_rows_
+          read (s,fmt_) d(i, :)
+        enddo
+      endif
+      #:elif 'complex' in t1
+      ! Default to format used for savetxt if fmt not specified.
+      fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))")
+      if ( fmt_ == '*' ) then
+        ! Use list directed read if user has specified fmt='*'
+        do i = 1, max_rows_
+          read (s,*) d(i, :)
+        enddo
+      else
+        ! Otherwise pass default or user specified fmt string.
+        do i = 1, max_rows_
+          read (s,fmt_) d(i, :)
+        enddo
+      endif
+      #:else
+      ! Default to list directed for integer
+      fmt_ = optval(fmt, "*")
+      ! Use list directed read if user has specified fmt='*'
+      if ( fmt_ == '*' ) then
+        do i = 1, max_rows_
+          read (s,*) d(i, :)
+        enddo
+      else
+        ! Otherwise pass default user specified fmt string.
+        do i = 1, max_rows_
+          read (s,fmt_) d(i, :)
+        enddo
+      endif
+
+      #:endif
+
       close(s)
 
     end subroutine loadtxt_${t1[0]}$${k1}$

test/io/test_loadtxt.f90

@@ -43,9 +43,10 @@ subroutine test_loadtxt_int32(error)
             input = int(harvest * 100)
             call savetxt('test_int32.txt', input)
             call loadtxt('test_int32.txt', expected)
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'Default list directed read failed')
+            if (allocated(error)) return
             call loadtxt('test_int32.txt', expected, fmt='*')
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'User specified list directed read faile')
             if (allocated(error)) return
         end do
 
@@ -67,11 +68,13 @@ subroutine test_loadtxt_sp(error)
             input = input - 0.5
             call savetxt('test_sp.txt', input)
             call loadtxt('test_sp.txt', expected)
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'Default format read failed')
+            if (allocated(error)) return
             call loadtxt('test_sp.txt', expected, fmt='*')
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'List directed read failed')
+            if (allocated(error)) return
             call loadtxt('test_sp.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'User specified format failed')
             if (allocated(error)) return
         end do
 
@@ -93,11 +96,13 @@ subroutine test_loadtxt_sp_huge(error)
             input = (input - 0.5) * huge(input)
             call savetxt('test_sp_huge.txt', input)
             call loadtxt('test_sp_huge.txt', expected)
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'Default format read failed')
+            if (allocated(error)) return
             call loadtxt('test_sp_huge.txt', expected, fmt='*')
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'List directed read failed')
+            if (allocated(error)) return
             call loadtxt('test_sp_huge.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'User specified format failed')
             if (allocated(error)) return
         end do
 
@@ -119,11 +124,13 @@ subroutine test_loadtxt_sp_tiny(error)
             input = (input - 0.5) * tiny(input)
             call savetxt('test_sp_tiny.txt', input)
             call loadtxt('test_sp_tiny.txt', expected)
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'Default format read failed')
+            if (allocated(error)) return
             call loadtxt('test_sp_tiny.txt', expected, fmt='*')
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'List directed read failed')
+            if (allocated(error)) return
             call loadtxt('test_sp_tiny.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'User specified format failed')
             if (allocated(error)) return
         end do
 
@@ -145,11 +152,13 @@ subroutine test_loadtxt_dp(error)
             input = input - 0.5
             call savetxt('test_dp.txt', input)
             call loadtxt('test_dp.txt', expected)
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'Default format read failed')
+            if (allocated(error)) return
             call loadtxt('test_dp.txt', expected, fmt='*')
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'List directed read failed')
+            if (allocated(error)) return
             call loadtxt('test_dp.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'User specified format failed')
             if (allocated(error)) return
         end do
 
@@ -171,11 +180,13 @@ subroutine test_loadtxt_dp_max_skip(error)
                 input = input - 0.5
                 call savetxt('test_dp_max_skip.txt', input)
                 call loadtxt('test_dp_max_skip.txt', expected, skiprows=m, max_rows=n)
-                call check(error, all(input(m+1:min(n+m,10),:) == expected))
+                call check(error, all(input(m+1:min(n+m,10),:) == expected),'Default format read failed')
+                if (allocated(error)) return
                 call loadtxt('test_dp_max_skip.txt', expected, skiprows=m, max_rows=n, fmt='*')
-                call check(error, all(input(m+1:min(n+m,10),:) == expected))
+                call check(error, all(input(m+1:min(n+m,10),:) == expected),'List directed read failed')
+                if (allocated(error)) return
                 call loadtxt('test_dp_max_skip.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
-                call check(error, all(input == expected))
+                call check(error, all(input == expected),'User specified format failed')
                 deallocate(expected)
                 if (allocated(error)) return
             end do
@@ -199,11 +210,13 @@ subroutine test_loadtxt_dp_huge(error)
             input = (input - 0.5) * huge(input)
             call savetxt('test_dp_huge.txt', input)
             call loadtxt('test_dp_huge.txt', expected)
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'Default format read failed')
+            if (allocated(error)) return
             call loadtxt('test_dp_huge.txt', expected, fmt='*')
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'List directed read failed')
+            if (allocated(error)) return
             call loadtxt('test_dp_huge.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'User specified format failed')
             if (allocated(error)) return
         end do
 
@@ -225,11 +238,13 @@ subroutine test_loadtxt_dp_tiny(error)
             input = (input - 0.5) * tiny(input)
             call savetxt('test_dp_tiny.txt', input)
             call loadtxt('test_dp_tiny.txt', expected)
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'Default format read failed')
+            if (allocated(error)) return
             call loadtxt('test_dp_tiny.txt', expected, fmt='*')
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'List directed read failed')
+            if (allocated(error)) return
             call loadtxt('test_dp_tiny.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
-            call check(error, all(input == expected))
+            call check(error, all(input == expected),'User specified format failed')
             if (allocated(error)) return
         end do