Merge pull request #26 from zoziha/testdrive

Use testdrive for unit tests

Author: zoziha

fpm.toml

@@ -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"

test/Makefile

@@ -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

test/test_fftpack.f90

@@ -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

test/test_fftpack_dcosq.f90

@@ -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