Use portable formats in savetxt and loadtxt

* Update tests for savetxt and loadtxt; compare exact values, not approximate; remove hardcoded test files
* Remove unused variable
* Update edit descriptors for savetxt and loadtxt; Small fix in number_of_rows() to make ifort happy
* Tests loadtxt with tiny and huge numbers
* Compare arrays exactly in test_savetxt_qp.f90

Author: milancurcic

src/stdlib_io.fypp

@@ -19,6 +19,16 @@ module stdlib_io
   ! Private API that is exposed so that we can test it in tests
   public :: parse_mode
 
+  ! Format strings with edit descriptors for each type and kind
+  character(*), parameter :: &
+    FMT_INT = '(*(i0,1x))', &
+    FMT_REAL_SP = '(*(es15.8e2,1x))', &
+    FMT_REAL_DP = '(*(es24.16e3,1x))', &
+    FMT_REAL_QP = '(*(es44.35e4,1x))', &
+    FMT_COMPLEX_SP = '(*(es15.8e2,1x,es15.8e2))', &
+    FMT_COMPLEX_DP = '(*(es24.16e3,1x,es24.16e3))', &
+    FMT_COMPLEX_QP = '(*(es44.35e4,1x,es44.35e4))'
+
   interface loadtxt
     !! version: experimental
     !!
@@ -78,13 +88,22 @@ contains
 
       ! determine number of columns
       ncol = number_of_columns(s)
+      #:if 'complex' in t1
+      ncol = ncol / 2
+      #:endif
 
       ! determine number or rows
-      nrow = number_of_rows_numeric(s)
+      nrow = number_of_rows(s)
 
       allocate(d(nrow, ncol))
       do i = 1, nrow
-        read(s, *) d(i, :)
+        #:if 'real' in t1
+          read(s, FMT_REAL_${k1}$) d(i, :)
+        #:elif 'complex' in t1
+          read(s, FMT_COMPLEX_${k1}$) d(i, :)
+        #:else
+          read(s, *) d(i, :)
+        #:endif
       end do
       close(s)
 
@@ -116,7 +135,15 @@ contains
       integer :: s, i
       s = open(filename, "w")
       do i = 1, size(d, 1)
-        write(s, *) d(i, :)
+        #:if 'real' in t1
+          write(s, FMT_REAL_${k1}$) d(i, :)
+        #:elif 'complex' in t1
+          write(s, FMT_COMPLEX_${k1}$) d(i, :)
+        #:elif 'integer' in t1
+          write(s, FMT_INT) d(i, :)
+        #:else
+          write(s, *) d(i, :)
+        #:endif
       end do
       close(s)
     end subroutine savetxt_${t1[0]}$${k1}$
@@ -147,36 +174,24 @@ contains
   end function number_of_columns
 
 
-  integer function number_of_rows_numeric(s) result(nrows)
+  integer function number_of_rows(s) result(nrows)
     !! version: experimental
     !!
-    !! determine number or rows
-    integer,intent(in)::s
+    !! Determine the number or rows in a file
+    integer, intent(in)::s
     integer :: ios
 
-    real :: r
-    complex :: z
-
     rewind(s)
     nrows = 0
     do
-      read(s, *, iostat=ios) r
+      read(s, *, iostat=ios)
       if (ios /= 0) exit
       nrows = nrows + 1
     end do
 
     rewind(s)
 
-    ! If there are no rows of real numbers, it may be that they are complex
-    if( nrows == 0) then
-      do
-        read(s, *, iostat=ios) z
-        if (ios /= 0) exit
-        nrows = nrows + 1
-      end do
-      rewind(s)
-    end if
-  end function number_of_rows_numeric
+  end function number_of_rows
 
 
   integer function open(filename, mode, iostat) result(u)
@@ -314,4 +329,4 @@ contains
 
   end function parse_mode
 
-end module
+end module stdlib_io

src/tests/io/Makefile.manual

@@ -5,7 +5,6 @@ PROGS_SRC = test_loadtxt.f90 \
             test_parse_mode.f90 \
             test_open.f90
 
-CLEAN_FILES = tmp*.dat array*_new.dat io_open.dat io_open.stream
-
+CLEAN_FILES = tmp*.dat io_open.dat io_open.stream
 
 include ../Makefile.manual.test.mk

src/tests/io/array1.dat

@@ -16,7 +16,11 @@ subroutine collect_loadtxt(testsuite)
         testsuite = [ &
             new_unittest("loadtxt_int32", test_loadtxt_int32), &
             new_unittest("loadtxt_sp", test_loadtxt_sp), &
+            new_unittest("loadtxt_sp_huge", test_loadtxt_sp_huge), &
+            new_unittest("loadtxt_sp_tiny", test_loadtxt_sp_tiny), &
             new_unittest("loadtxt_dp", test_loadtxt_dp), &
+            new_unittest("loadtxt_dp_huge", test_loadtxt_dp_huge), &
+            new_unittest("loadtxt_dp_tiny", test_loadtxt_dp_tiny), &
             new_unittest("loadtxt_complex", test_loadtxt_complex) &
         ]
 
@@ -27,18 +31,21 @@ subroutine test_loadtxt_int32(error)
         !> Error handling
         type(error_type), allocatable, intent(out) :: error
         integer(int32), allocatable :: input(:,:), expected(:,:)
-
-        call loadtxt("array1.dat", input)
-        call savetxt("array1_new.dat", input)
-        call loadtxt("array1_new.dat", expected)
-        call check(error, all(input == expected))
-        if (allocated(error)) return
-
-        call loadtxt("array2.dat", input)
-        call savetxt("array2_new.dat", input)
-        call loadtxt("array2_new.dat", expected)
-        call check(error, all(input == expected))
-        if (allocated(error)) return
+        real(sp), allocatable :: harvest(:,:)
+        integer :: n
+
+        allocate(harvest(10,10))
+        allocate(input(10,10))
+        allocate(expected(10,10))
+
+        do n = 1, 10
+            call random_number(harvest)
+            input = int(harvest * 100)
+            call savetxt('test_int32.txt', input)
+            call loadtxt('test_int32.txt', expected)
+            call check(error, all(input == expected))
+            if (allocated(error)) return
+        end do
 
     end subroutine test_loadtxt_int32
 
@@ -47,54 +54,151 @@ subroutine test_loadtxt_sp(error)
         !> Error handling
         type(error_type), allocatable, intent(out) :: error
         real(sp), allocatable :: input(:,:), expected(:,:)
+        integer :: n
 
-        call loadtxt("array3.dat", input)
-        call savetxt("array3_sp.dat", input)
-        call loadtxt("array3_sp.dat", expected)
-        call check(error, all(input == expected))
-        if (allocated(error)) return
+        allocate(input(10,10))
+        allocate(expected(10,10))
 
-        call loadtxt("array4.dat", input)
-        call savetxt("array4_sp.dat", input)
-        call loadtxt("array4_sp.dat", expected)
-        call check(error, all(input == expected))
-        if (allocated(error)) return
+        do n = 1, 10
+            call random_number(input)
+            input = input - 0.5
+            call savetxt('test_sp.txt', input)
+            call loadtxt('test_sp.txt', expected)
+            call check(error, all(input == expected))
+            if (allocated(error)) return
+        end do
 
     end subroutine test_loadtxt_sp
 
 
+    subroutine test_loadtxt_sp_huge(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        real(sp), allocatable :: input(:,:), expected(:,:)
+        integer :: n
+
+        allocate(input(10,10))
+        allocate(expected(10,10))
+
+        do n = 1, 10
+            call random_number(input)
+            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))
+            if (allocated(error)) return
+        end do
+
+    end subroutine test_loadtxt_sp_huge
+
+
+    subroutine test_loadtxt_sp_tiny(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        real(sp), allocatable :: input(:,:), expected(:,:)
+        integer :: n
+
+        allocate(input(10,10))
+        allocate(expected(10,10))
+
+        do n = 1, 10
+            call random_number(input)
+            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))
+            if (allocated(error)) return
+        end do
+
+    end subroutine test_loadtxt_sp_tiny
+
+
     subroutine test_loadtxt_dp(error)
         !> Error handling
         type(error_type), allocatable, intent(out) :: error
         real(dp), allocatable :: input(:,:), expected(:,:)
+        integer :: n
 
-        call loadtxt("array3.dat", input)
-        call savetxt("array3_dp.dat", input)
-        call loadtxt("array3_dp.dat", expected)
-        call check(error, all(input == expected))
-        if (allocated(error)) return
+        allocate(input(10,10))
+        allocate(expected(10,10))
 
-        call loadtxt("array4.dat", input)
-        call savetxt("array4_dp.dat", input)
-        call loadtxt("array4_dp.dat", expected)
-        call check(error, all(input == expected))
-        if (allocated(error)) return
+        do n = 1, 10
+            call random_number(input)
+            input = input - 0.5
+            call savetxt('test_dp.txt', input)
+            call loadtxt('test_dp.txt', expected)
+            call check(error, all(input == expected))
+            if (allocated(error)) return
+        end do
 
     end subroutine test_loadtxt_dp
 
 
-    subroutine test_loadtxt_complex(error)
-      !> Error handling
-      type(error_type), allocatable, intent(out) :: error
-      complex(dp), allocatable :: input(:,:), expected(:,:)
+    subroutine test_loadtxt_dp_huge(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        real(dp), allocatable :: input(:,:), expected(:,:)
+        integer :: n
+
+        allocate(input(10,10))
+        allocate(expected(10,10))
+
+        do n = 1, 10
+            call random_number(input)
+            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))
+            if (allocated(error)) return
+        end do
+
+    end subroutine test_loadtxt_dp_huge
+
+
+    subroutine test_loadtxt_dp_tiny(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        real(dp), allocatable :: input(:,:), expected(:,:)
+        integer :: n
+
+        allocate(input(10,10))
+        allocate(expected(10,10))
+
+        do n = 1, 10
+            call random_number(input)
+            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))
+            if (allocated(error)) return
+        end do
 
-      call loadtxt("array5.dat", input)
-      call savetxt("array5_new.dat", input)
-      call loadtxt("array5_new.dat", expected)
-      call check(error, all(input == expected))
-      if (allocated(error)) return
+    end subroutine test_loadtxt_dp_tiny
 
-  end subroutine test_loadtxt_complex
+
+    subroutine test_loadtxt_complex(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        complex(dp), allocatable :: input(:,:), expected(:,:)
+        real(dp), allocatable :: re(:,:), im(:,:)
+        integer :: n
+
+        allocate(re(10,10))
+        allocate(im(10,10))
+        allocate(input(10,10))
+        allocate(expected(10,10))
+
+        do n = 1, 10
+            call random_number(re)
+            call random_number(im)
+            input = cmplx(re, im)
+            call savetxt('test_complex.txt', input)
+            call loadtxt('test_complex.txt', expected)
+            call check(error, all(input == expected))
+            if (allocated(error)) return
+        end do
+
+    end subroutine test_loadtxt_complex
 
 end module test_loadtxt