From 9033999fe0f5e8de88f3ea5848ac8bd1f5f67832 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Thu, 2 Jan 2020 09:52:29 -0700 Subject: [PATCH 1/3] Split the loadtxt qp tests and skip them on Win --- .github/workflows/ci_windows.yml | 2 +- src/tests/loadtxt/CMakeLists.txt | 17 ++++++++-- src/tests/loadtxt/test_loadtxt.f90 | 6 +--- src/tests/loadtxt/test_loadtxt_qp.f90 | 38 ++++++++++++++++++++++ src/tests/loadtxt/test_savetxt_qp.f90 | 45 +++++++++++++++++++++++++++ 5 files changed, 100 insertions(+), 8 deletions(-) create mode 100644 src/tests/loadtxt/test_loadtxt_qp.f90 create mode 100644 src/tests/loadtxt/test_savetxt_qp.f90 diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 9b0f856bd..077db6bb2 100644 --- a/.github/workflows/ci_windows.yml +++ b/.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 diff --git a/src/tests/loadtxt/CMakeLists.txt b/src/tests/loadtxt/CMakeLists.txt index 318a865c7..5cef2a4f8 100644 --- a/src/tests/loadtxt/CMakeLists.txt +++ b/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 $ ${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 $ ${CMAKE_CURRENT_BINARY_DIR} + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) +add_test(NAME savetxt COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) -add_test(NAME save_text COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} +add_test(NAME loadtxt_qp COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) +add_test(NAME savetxt_qp COMMAND $ ${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) diff --git a/src/tests/loadtxt/test_loadtxt.f90 b/src/tests/loadtxt/test_loadtxt.f90 index 4caee4008..6d69077be 100644 --- a/src/tests/loadtxt/test_loadtxt.f90 +++ b/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, qp=>real128 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) diff --git a/src/tests/loadtxt/test_loadtxt_qp.f90 b/src/tests/loadtxt/test_loadtxt_qp.f90 new file mode 100644 index 000000000..86f8475b2 --- /dev/null +++ b/src/tests/loadtxt/test_loadtxt_qp.f90 @@ -0,0 +1,38 @@ +program test_loadtxt_qp +use iso_fortran_env, only: sp=>real32, dp=>real64, 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(sp)) + do i = 1, size(a, 1) + print *, a(i, :) + end do + type is(real(dp)) + 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 + end select + +end subroutine + +end program diff --git a/src/tests/loadtxt/test_savetxt_qp.f90 b/src/tests/loadtxt/test_savetxt_qp.f90 new file mode 100644 index 000000000..6d31c3e29 --- /dev/null +++ b/src/tests/loadtxt/test_savetxt_qp.f90 @@ -0,0 +1,45 @@ +program test_loadtxt +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 From 3e11abcba8dae2aeb93c2bc0d83fd5899195f006 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Thu, 2 Jan 2020 11:17:33 -0700 Subject: [PATCH 2/3] Apply suggestions from code review Co-Authored-By: Jeremie Vandenplas --- src/tests/loadtxt/test_loadtxt.f90 | 2 +- src/tests/loadtxt/test_loadtxt_qp.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tests/loadtxt/test_loadtxt.f90 b/src/tests/loadtxt/test_loadtxt.f90 index 6d69077be..2709689d0 100644 --- a/src/tests/loadtxt/test_loadtxt.f90 +++ b/src/tests/loadtxt/test_loadtxt.f90 @@ -1,5 +1,5 @@ program test_loadtxt -use iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128 +use iso_fortran_env, only: sp=>real32, dp=>real64!, qp=>real128 use stdlib_experimental_io, only: loadtxt implicit none diff --git a/src/tests/loadtxt/test_loadtxt_qp.f90 b/src/tests/loadtxt/test_loadtxt_qp.f90 index 86f8475b2..37e1b625d 100644 --- a/src/tests/loadtxt/test_loadtxt_qp.f90 +++ b/src/tests/loadtxt/test_loadtxt_qp.f90 @@ -1,5 +1,5 @@ program test_loadtxt_qp -use iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128 +use iso_fortran_env, only: qp=>real128 use stdlib_experimental_io, only: loadtxt implicit none From 84975608064f4fdaa1160ee79bc45508b4d771e9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Thu, 2 Jan 2020 11:19:49 -0700 Subject: [PATCH 3/3] Only do qp in the test_*_qp.f90 tests --- src/tests/loadtxt/test_loadtxt.f90 | 6 +----- src/tests/loadtxt/test_loadtxt_qp.f90 | 8 -------- src/tests/loadtxt/test_savetxt.f90 | 22 ++-------------------- src/tests/loadtxt/test_savetxt_qp.f90 | 2 +- 4 files changed, 4 insertions(+), 34 deletions(-) diff --git a/src/tests/loadtxt/test_loadtxt.f90 b/src/tests/loadtxt/test_loadtxt.f90 index 2709689d0..8c8333425 100644 --- a/src/tests/loadtxt/test_loadtxt.f90 +++ b/src/tests/loadtxt/test_loadtxt.f90 @@ -1,5 +1,5 @@ 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 @@ -37,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 diff --git a/src/tests/loadtxt/test_loadtxt_qp.f90 b/src/tests/loadtxt/test_loadtxt_qp.f90 index 37e1b625d..7ac4aa221 100644 --- a/src/tests/loadtxt/test_loadtxt_qp.f90 +++ b/src/tests/loadtxt/test_loadtxt_qp.f90 @@ -16,14 +16,6 @@ subroutine print_array(a) print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")" select type(a) - type is(real(sp)) - do i = 1, size(a, 1) - print *, a(i, :) - end do - type is(real(dp)) - do i = 1, size(a, 1) - print *, a(i, :) - end do type is(real(qp)) do i = 1, size(a, 1) print *, a(i, :) diff --git a/src/tests/loadtxt/test_savetxt.f90 b/src/tests/loadtxt/test_savetxt.f90 index 172c52b6b..273e72973 100644 --- a/src/tests/loadtxt/test_savetxt.f90 +++ b/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 diff --git a/src/tests/loadtxt/test_savetxt_qp.f90 b/src/tests/loadtxt/test_savetxt_qp.f90 index 6d31c3e29..31492a0d0 100644 --- a/src/tests/loadtxt/test_savetxt_qp.f90 +++ b/src/tests/loadtxt/test_savetxt_qp.f90 @@ -1,4 +1,4 @@ -program test_loadtxt +program test_savetxt_qp use iso_fortran_env, only: qp=>real128 use stdlib_experimental_io, only: loadtxt, savetxt use stdlib_experimental_error, only: assert