Skip to content

Commit 8497560

Browse files
committed
Only do qp in the test_*_qp.f90 tests
1 parent 3e11abc commit 8497560

File tree

4 files changed

+4
-34
lines changed

4 files changed

+4
-34
lines changed

src/tests/loadtxt/test_loadtxt.f90

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
program test_loadtxt
2-
use iso_fortran_env, only: sp=>real32, dp=>real64!, qp=>real128
2+
use iso_fortran_env, only: sp=>real32, dp=>real64
33
use stdlib_experimental_io, only: loadtxt
44
implicit none
55

@@ -37,10 +37,6 @@ subroutine print_array(a)
3737
do i = 1, size(a, 1)
3838
print *, a(i, :)
3939
end do
40-
type is(real(qp))
41-
do i = 1, size(a, 1)
42-
print *, a(i, :)
43-
end do
4440
class default
4541
write(*,'(a)')'The proposed type is not supported'
4642
error stop

src/tests/loadtxt/test_loadtxt_qp.f90

Lines changed: 0 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -16,14 +16,6 @@ subroutine print_array(a)
1616
print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")"
1717

1818
select type(a)
19-
type is(real(sp))
20-
do i = 1, size(a, 1)
21-
print *, a(i, :)
22-
end do
23-
type is(real(dp))
24-
do i = 1, size(a, 1)
25-
print *, a(i, :)
26-
end do
2719
type is(real(qp))
2820
do i = 1, size(a, 1)
2921
print *, a(i, :)

src/tests/loadtxt/test_savetxt.f90

Lines changed: 2 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
1-
program test_loadtxt
2-
use iso_fortran_env, only: sp=>real32, dp=>real64 ,qp=>real128
1+
program test_savetxt
2+
use iso_fortran_env, only: sp=>real32, dp=>real64
33
use stdlib_experimental_io, only: loadtxt, savetxt
44
use stdlib_experimental_error, only: assert
55
implicit none
@@ -10,7 +10,6 @@ program test_loadtxt
1010

1111
call test_sp(outpath)
1212
call test_dp(outpath)
13-
!call test_qp(outpath)
1413

1514
contains
1615

@@ -62,21 +61,4 @@ subroutine test_dp(outpath)
6261
call assert(all(abs(e-d2) < epsilon(1._dp)))
6362
end subroutine
6463

65-
subroutine test_qp(outpath)
66-
character(*), intent(in) :: outpath
67-
real(qp) :: d(3, 2), e(2, 3)
68-
real(qp), allocatable :: d2(:, :)
69-
d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
70-
call savetxt(outpath, d)
71-
call loadtxt(outpath, d2)
72-
call assert(all(shape(d2) == [3, 2]))
73-
call assert(all(abs(d-d2) < epsilon(1._qp)))
74-
75-
e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
76-
call savetxt(outpath, e)
77-
call loadtxt(outpath, d2)
78-
call assert(all(shape(d2) == [2, 3]))
79-
call assert(all(abs(e-d2) < epsilon(1._qp)))
80-
end subroutine
81-
8264
end program

src/tests/loadtxt/test_savetxt_qp.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
program test_loadtxt
1+
program test_savetxt_qp
22
use iso_fortran_env, only: qp=>real128
33
use stdlib_experimental_io, only: loadtxt, savetxt
44
use stdlib_experimental_error, only: assert

0 commit comments

Comments
 (0)