Skip to content

Commit

Permalink
Merge pull request #26 from zoziha/testdrive
Browse files Browse the repository at this point in the history 
Use testdrive for unit tests
  • Loading branch information
@zoziha
zoziha authored May 7, 2022
2 parents 18886cd + 2edada5 commit 8f1f4e4
Show file tree
Hide file tree
Showing 18 changed files with 428 additions and 562 deletions.
76 changes: 6 additions & 70 deletions fpm.toml
View file
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
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 $@.x
time ./tstfft.x

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

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

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

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

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

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

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

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

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

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

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

fftpack_ifftshift: test_fftpack_ifftshift.f90
$(FC) $(FFLAGS) $< -L../src -l$(LIB) -I../src -o $@.x
./fftpack_ifftshift.x
test_fftpack: $(OBJ)
$(FC) $(FFLAGS) $(OBJ) -L../src -l$(LIB) -I../src -o $@.x
./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
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

This file was deleted.

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

This file was deleted.

83 changes: 55 additions & 28 deletions test/test_fftpack_dct.f90
View file
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

0 comments on commit 8f1f4e4

Please sign in to comment.