Merge pull request #65 from certik/quad

Split the loadtxt qp tests and skip them on Win

Author: certik

.github/workflows/ci_windows.yml

@@ -28,7 +28,7 @@ jobs:
       if: failure()
 
     - name: CTest
-      run: ctest --output-on-failure --parallel -V
+      run: ctest --output-on-failure --parallel -V -LE quadruple_precision
       working-directory: build
 
     - uses: actions/upload-artifact@v1

src/tests/loadtxt/CMakeLists.txt

@@ -4,7 +4,20 @@ target_link_libraries(test_loadtxt fortran_stdlib)
 add_executable(test_savetxt test_savetxt.f90)
 target_link_libraries(test_savetxt fortran_stdlib)
 
-add_test(NAME load_text COMMAND $<TARGET_FILE:test_loadtxt> ${CMAKE_CURRENT_BINARY_DIR}
+add_executable(test_loadtxt_qp test_loadtxt_qp.f90)
+target_link_libraries(test_loadtxt_qp fortran_stdlib)
+
+add_executable(test_savetxt_qp test_savetxt_qp.f90)
+target_link_libraries(test_savetxt_qp fortran_stdlib)
+
+add_test(NAME loadtxt COMMAND $<TARGET_FILE:test_loadtxt> ${CMAKE_CURRENT_BINARY_DIR}
+  WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
+add_test(NAME savetxt COMMAND $<TARGET_FILE:test_savetxt> ${CMAKE_CURRENT_BINARY_DIR}
   WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
-add_test(NAME save_text COMMAND $<TARGET_FILE:test_savetxt> ${CMAKE_CURRENT_BINARY_DIR}
+add_test(NAME loadtxt_qp COMMAND $<TARGET_FILE:test_loadtxt_qp> ${CMAKE_CURRENT_BINARY_DIR}
   WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
+add_test(NAME savetxt_qp COMMAND $<TARGET_FILE:test_savetxt_qp> ${CMAKE_CURRENT_BINARY_DIR}
+  WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
+
+set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision)
+set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision)

src/tests/loadtxt/test_loadtxt.f90

@@ -1,11 +1,10 @@
 program test_loadtxt
-use iso_fortran_env, only: sp=>real32, dp=>real64 ,qp=>real128
+use iso_fortran_env, only: sp=>real32, dp=>real64
 use stdlib_experimental_io, only: loadtxt
 implicit none
 
 real(sp), allocatable :: s(:, :)
 real(dp), allocatable :: d(:, :)
-!real(qp), allocatable :: q(:, :)
 
 call loadtxt("array1.dat", s)
 call print_array(s)
@@ -22,9 +21,6 @@ program test_loadtxt
 call loadtxt("array4.dat", d)
 call print_array(d)
 
-!call loadtxt("array4.dat", q)
-!call print_array(q)
-
 contains
 
 subroutine print_array(a)
@@ -41,10 +37,6 @@ subroutine print_array(a)
    do i = 1, size(a, 1)
     print *, a(i, :)
    end do
-  type is(real(qp))
-   do i = 1, size(a, 1)
-    print *, a(i, :)
-   end do
   class default
    write(*,'(a)')'The proposed type is not supported'
    error stop

src/tests/loadtxt/test_loadtxt_qp.f90

@@ -0,0 +1,30 @@
+program test_loadtxt_qp
+use iso_fortran_env, only: qp=>real128
+use stdlib_experimental_io, only: loadtxt
+implicit none
+
+real(qp), allocatable :: q(:, :)
+
+call loadtxt("array4.dat", q)
+call print_array(q)
+
+contains
+
+subroutine print_array(a)
+class(*),intent(in) :: a(:, :)
+integer :: i
+print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")"
+
+ select type(a)
+  type is(real(qp))
+   do i = 1, size(a, 1)
+    print *, a(i, :)
+   end do
+  class default
+   write(*,'(a)')'The proposed type is not supported'
+   error stop
+ end select
+
+end subroutine
+
+end program

src/tests/loadtxt/test_savetxt.f90

@@ -1,5 +1,5 @@
-program test_loadtxt
-use iso_fortran_env, only: sp=>real32, dp=>real64 ,qp=>real128
+program test_savetxt
+use iso_fortran_env, only: sp=>real32, dp=>real64
 use stdlib_experimental_io, only: loadtxt, savetxt
 use stdlib_experimental_error, only: assert
 implicit none
@@ -10,7 +10,6 @@ program test_loadtxt
 
 call test_sp(outpath)
 call test_dp(outpath)
-!call test_qp(outpath)
 
 contains
 
@@ -62,21 +61,4 @@ subroutine test_dp(outpath)
     call assert(all(abs(e-d2) < epsilon(1._dp)))
     end subroutine
 
-    subroutine test_qp(outpath)
-    character(*), intent(in) :: outpath
-    real(qp) :: d(3, 2), e(2, 3)
-    real(qp), allocatable :: d2(:, :)
-    d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
-    call savetxt(outpath, d)
-    call loadtxt(outpath, d2)
-    call assert(all(shape(d2) == [3, 2]))
-    call assert(all(abs(d-d2) < epsilon(1._qp)))
-
-    e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
-    call savetxt(outpath, e)
-    call loadtxt(outpath, d2)
-    call assert(all(shape(d2) == [2, 3]))
-    call assert(all(abs(e-d2) < epsilon(1._qp)))
-    end subroutine
-
 end program

src/tests/loadtxt/test_savetxt_qp.f90

@@ -0,0 +1,45 @@
+program test_savetxt_qp
+use iso_fortran_env, only: qp=>real128
+use stdlib_experimental_io, only: loadtxt, savetxt
+use stdlib_experimental_error, only: assert
+implicit none
+
+character(:), allocatable :: outpath
+
+outpath = get_outpath() // "/tmp_qp.dat"
+
+call test_qp(outpath)
+
+contains
+
+    function get_outpath() result(outpath)
+    integer :: ierr
+    character(256) :: argv
+    character(:), allocatable :: outpath
+
+    call get_command_argument(1, argv, status=ierr)
+    if (ierr==0) then
+        outpath = trim(argv)
+    else
+        outpath = '.'
+    endif
+    end function get_outpath
+
+    subroutine test_qp(outpath)
+    character(*), intent(in) :: outpath
+    real(qp) :: d(3, 2), e(2, 3)
+    real(qp), allocatable :: d2(:, :)
+    d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
+    call savetxt(outpath, d)
+    call loadtxt(outpath, d2)
+    call assert(all(shape(d2) == [3, 2]))
+    call assert(all(abs(d-d2) < epsilon(1._qp)))
+
+    e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
+    call savetxt(outpath, e)
+    call loadtxt(outpath, d2)
+    call assert(all(shape(d2) == [2, 3]))
+    call assert(all(abs(e-d2) < epsilon(1._qp)))
+    end subroutine
+
+end program