Skip to content

Use testdrive for unit tests #26

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
May 7, 2022
Merged

Use testdrive for unit tests #26

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
76 changes: 6 additions & 70 deletions fpm.toml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,82 +13,18 @@ keywords = ["netlib", "fftpack", "fft"]
[build]
auto-executables = false
auto-tests = false
auto-examples = true
auto-examples = false

[dev-dependencies]
test-drive = { git = "https://github.com/fortran-lang/test-drive", tag = "v0.4.0" }

# Original test
[[test]]
name = "tstfft"
source-dir = "test"
main = "tstfft.f"

# `fftpack` fft routines
[[test]]
name = "fftpack_zfft"
source-dir = "test"
main = "test_fftpack_zfft.f90"

[[test]]
name = "fftpack_fft"
source-dir = "test"
main = "test_fftpack_fft.f90"

[[test]]
name = "fftpack_ifft"
source-dir = "test"
main = "test_fftpack_ifft.f90"

[[test]]
name = "fftpack_dfft"
source-dir = "test"
main = "test_fftpack_dfft.f90"

[[test]]
name = "fftpack_rfft"
source-dir = "test"
main = "test_fftpack_rfft.f90"

[[test]]
name = "fftpack_irfft"
source-dir = "test"
main = "test_fftpack_irfft.f90"

[[test]]
name = "fftpack_dzfft"
source-dir = "test"
main = "test_fftpack_dzfft.f90"

[[test]]
name = "fftpack_dcosq"
source-dir = "test"
main = "test_fftpack_dcosq.f90"

[[test]]
name = "fftpack_qct"
source-dir = "test"
main = "test_fftpack_qct.f90"

[[test]]
name = "fftpack_iqct"
source-dir = "test"
main = "test_fftpack_iqct.f90"

[[test]]
name = "fftpack_dcost"
source-dir = "test"
main = "test_fftpack_dcost.f90"

[[test]]
name = "fftpack_dct"
source-dir = "test"
main = "test_fftpack_dct.f90"

# `fftpack` utility routines
[[test]]
name = "fftpack_fftshift"
source-dir = "test"
main = "test_fftpack_fftshift.f90"

[[test]]
name = "fftpack_ifftshift"
name = "test_fftpack"
source-dir = "test"
main = "test_fftpack_ifftshift.f90"
main = "test_fftpack.f90"
102 changes: 41 additions & 61 deletions test/Makefile
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,71 +1,51 @@
FETCH = curl -L

SRC = \
test_fftpack_fft.f90 \
test_fftpack_rfft.f90 \
test_fftpack_qct.f90 \
test_fftpack_dct.f90 \
test_fftpack_utils.f90 \
test_fftpack.f90 \
testdrive.F90

OBJ = $(SRC:.f90=.o)
OBJ := $(OBJ:.F90=.o)

all: tstfft \
fftpack_fft \
fftpack_ifft \
fftpack_rfft \
fftpack_irfft \
fftpack_fftshift \
fftpack_ifftshift \
fftpack_dzfft \
fftpack_dcosq \
fftpack_qct \
fftpack_iqct \
fftpack_dcost \
fftpack_dct
test_fftpack

# Orginal test
tstfft: tstfft.f
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
time ./tstfft.x

# `fftpack` fft routines
fftpack_fft: test_fftpack_fft.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_fft.x

fftpack_ifft: test_fftpack_ifft.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_ifft.x

fftpack_rfft: test_fftpack_rfft.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_rfft.x

fftpack_irfft: test_fftpack_irfft.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_irfft.x

fftpack_dzfft: test_fftpack_dzfft.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_dzfft.x

fftpack_dcosq: test_fftpack_dcosq.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_dcosq.x

fftpack_qct: test_fftpack_qct.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_qct.x

fftpack_iqct: test_fftpack_iqct.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_iqct.x

fftpack_dcost: test_fftpack_dcost.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_dcost.x

fftpack_dct: test_fftpack_dct.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_dct.x

# `fftpack` utility routines
fftpack_fftshift: test_fftpack_fftshift.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_fftshift.x

fftpack_ifftshift: test_fftpack_ifftshift.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o [email protected]
./fftpack_ifftshift.x
test_fftpack: $(OBJ)
$(FC) $(FFLAGS) $(OBJ) -L../src -l$(LIB) -I../src -o [email protected]
./test_fftpack.x

testdrive.F90:
$(FETCH) https://github.com/fortran-lang/test-drive/raw/v0.4.0/src/testdrive.F90 > $@

%.o: %.F90
$(FC) $(FFLAGS) -c $<

%.o: %.f90
$(FC) $(FFLAGS) -I../src -c $<

test_fftpack.o: test_fftpack_fft.o \
test_fftpack_rfft.o \
test_fftpack_qct.o \
test_fftpack_dct.o \
test_fftpack_utils.o \
testdrive.o

test_fftpack_fft.o: testdrive.o
test_fftpack_rfft.o: testdrive.o
test_fftpack_qct.o: testdrive.o
test_fftpack_dct.o: testdrive.o
test_fftpack_utils.o: testdrive.o

clean:
rm -f -r *.o *.x
rm -f -r *.o *.mod *.smod *.x testdrive.F90
34 changes: 34 additions & 0 deletions test/test_fftpack.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,34 @@
program test_fftpack
use, intrinsic :: iso_fortran_env, only: error_unit
use testdrive, only: run_testsuite, new_testsuite, testsuite_type
use test_fftpack_fft, only: collect_fft
use test_fftpack_rfft, only: collect_rfft
use test_fftpack_qct, only: collect_qct
use test_fftpack_dct, only: collect_dct
use test_fftpack_utils, only: collect_utils
implicit none
integer :: stat, is
type(testsuite_type), allocatable :: testsuites(:)
character(len=*), parameter :: fmt = '("#", *(1x, a))'

stat = 0

testsuites = [ &
new_testsuite("fft", collect_fft), &
new_testsuite("rfft", collect_rfft), &
new_testsuite("qct", collect_qct), &
new_testsuite("dct", collect_dct), &
new_testsuite("utils", collect_utils) &
]

do is = 1, size(testsuites)
write (error_unit, fmt) "Testing:", testsuites(is)%name
call run_testsuite(testsuites(is)%collect, error_unit, stat)
end do

if (stat > 0) then
write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop
end if

end program test_fftpack
30 changes: 0 additions & 30 deletions test/test_fftpack_dcosq.f90
View file
Open in desktop

This file was deleted.

30 changes: 0 additions & 30 deletions test/test_fftpack_dcost.f90
View file
Open in desktop

This file was deleted.

83 changes: 55 additions & 28 deletions test/test_fftpack_dct.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,43 +1,70 @@
program tester
module test_fftpack_dct

call test_fftpack_dct()
call test_fftpack_idct()
print *, "All tests in `test_fftpack_dct` passed."
use fftpack, only: rk, dcosti, dcost, dct, idct
use testdrive, only: new_unittest, unittest_type, error_type, check
implicit none
private

public :: collect_dct

contains

subroutine check(condition, msg)
logical, intent(in) :: condition
character(*), intent(in) :: msg
if (.not. condition) error stop msg
end subroutine check
!> Collect all exported unit tests
subroutine collect_dct(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)

testsuite = [ &
new_unittest("classic-dct-API", test_classic_dct), &
new_unittest("modernized-dct-API", test_modernized_dct), &
new_unittest("modernized-idct-API", test_modernized_idct) &
]

end subroutine collect_dct

subroutine test_classic_dct(error)
type(error_type), allocatable, intent(out) :: error
real(kind=rk) :: w(3*4 + 15)
real(kind=rk) :: x(4) = [1, 2, 3, 4]
real(kind=rk) :: eps = 1.0e-10_rk

call dcosti(4, w)
call dcost(4, x, w)
call check(error, all(x == [real(kind=rk) :: 15, -4, 0, -1.0000000000000009_rk]), "`dcosti` failed.")
if (allocated(error)) return

call dcost(4, x, w)
call check(error, all(x/(2.0_rk*(4.0_rk - 1.0_rk)) == [real(kind=rk) :: 1, 2, 3, 4]), "`dcost` failed.")

subroutine test_fftpack_dct
use fftpack, only: dct
use fftpack_kind
end subroutine test_classic_dct

subroutine test_modernized_dct(error)
type(error_type), allocatable, intent(out) :: error
real(kind=rk) :: x(3) = [9, -9, 3]

call check(all(dct(x, 2) == [real(kind=rk) :: 0, 18]), msg="`dct(x, 2)` failed.")
call check(all(dct(x, 3) == dct(x)), msg="`dct(x, 3)` failed.")
call check(all(dct(x, 4) == [real(kind=rk) :: -3, -3.0000000000000036_rk, 15, 33]), msg="`dct(x, 4)` failed.")
call check(error, all(dct(x, 2) == [real(kind=rk) :: 0, 18]), "`dct(x, 2)` failed.")
if (allocated(error)) return
call check(error, all(dct(x, 3) == dct(x)), "`dct(x, 3)` failed.")
if (allocated(error)) return
call check(error, all(dct(x, 4) == [real(kind=rk) :: -3, -3.0000000000000036_rk, 15, 33]), "`dct(x, 4)` failed.")

end subroutine test_fftpack_dct
end subroutine test_modernized_dct

subroutine test_fftpack_idct
use fftpack, only: dct, idct
use iso_fortran_env, only: rk => real64
subroutine test_modernized_idct(error)
type(error_type), allocatable, intent(out) :: error
real(kind=rk) :: eps = 1.0e-10_rk
real(kind=rk) :: x(4) = [1, 2, 3, 4]

call check(all(idct(dct(x))/(2.0_rk*(4.0_rk - 1.0_rk)) == [real(kind=rk) :: 1, 2, 3, 4]), &
msg="`idct(dct(x))/(2.0_rk*(4.0_rk-1.0_rk))` failed.")
call check(all(idct(dct(x), 2)/(2.0_rk*(2.0_rk - 1.0_rk)) == [real(kind=rk) :: 5.5, 9.5]), &
msg="`idct(dct(x), 2)/(2.0_rk*(2.0_rk-1.0_rk))` failed.")
call check(all(idct(dct(x, 2), 4)/(2.0_rk*(4.0_rk - 1.0_rk)) == &
[0.16666666666666666_rk, 0.33333333333333331_rk, 0.66666666666666663_rk, 0.83333333333333315_rk]), &
msg="`idct(dct(x, 2), 4)/(2.0_rk*(4.0_rk-1.0_rk))` failed.")
call check(error, all(idct(dct(x))/(2.0_rk*(4.0_rk - 1.0_rk)) == [real(kind=rk) :: 1, 2, 3, 4]), &
"`idct(dct(x))/(2.0_rk*(4.0_rk-1.0_rk))` failed.")
if (allocated(error)) return
call check(error, all(idct(dct(x), 2)/(2.0_rk*(2.0_rk - 1.0_rk)) == [real(kind=rk) :: 5.5, 9.5]), &
"`idct(dct(x), 2)/(2.0_rk*(2.0_rk-1.0_rk))` failed.")
if (allocated(error)) return
call check(error, all(idct(dct(x, 2), 4)/(2.0_rk*(4.0_rk - 1.0_rk)) == &
[0.16666666666666666_rk, 0.33333333333333331_rk, 0.66666666666666663_rk, 0.83333333333333315_rk]), &
"`idct(dct(x, 2), 4)/(2.0_rk*(4.0_rk-1.0_rk))` failed.")

end subroutine test_fftpack_idct
end subroutine test_modernized_idct

end program tester
end module test_fftpack_dct
Loading