add tests

add tests

add test file

Author: perazz

test/linalg/CMakeLists.txt

@@ -8,6 +8,6 @@ set(
 fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
 
 ADDTEST(linalg)
+ADDTEST(linalg_determinant)
 ADDTEST(linalg_matrix_property_checks)
 ADDTEST(blas_lapack)
-ADDTEST(linalg_determinant)

test/linalg/test_linalg_determinant.fypp

@@ -1,47 +1,42 @@
 #:include "common.fypp"
+#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
 ! Test matrix determinant
 module test_linalg_determinant
-    use stdlib_linalg_interface
+    use testdrive, only: error_type, check, new_unittest, unittest_type
+    use stdlib_linalg_constants
+    use stdlib_linalg, only: eye, det, linalg_state_type
 
     implicit none (type,external)
+    private
+    
+    public :: test_matrix_determinant 
 
     contains
+    
 
     !> Matrix inversion tests
-    subroutine test_matrix_determinant(error)
-        logical, intent(out) :: error
-
-        real :: t0,t1
-
-        call cpu_time(t0)
-
-        #:for rk,rt,ri in ALL_KINDS_TYPES
-        call test_${ri}$_eye_determinant(error)
-        if (error) return
-
-        call test_${ri}$_eye_multiple(error)
-        if (error) return
-        #: endfor
-
-        #:for ck,ct,ci in CMPL_KINDS_TYPES
-        call test_${ci}$_complex_determinant(error)
-        if (error) return
+    subroutine test_matrix_determinant(tests)
+        !> Collection of tests
+        type(unittest_type), allocatable, intent(out) :: tests(:)
+        
+        allocate(tests(0))
+
+        #:for rk,rt in RC_KINDS_TYPES
+        tests = [tests,new_unittest("$eye_det_${rt[0]}$${rk}$",test_${rt[0]}$${rk}$_eye_determinant)]
+        tests = [tests,new_unittest("$eye_det_multiple_${rt[0]}$${rk}$",test_${rt[0]}$${rk}$_eye_multiple)]
+        #:endfor
+        #:for ck,ct in CMPLX_KINDS_TYPES
+        tests = [tests,new_unittest("$complex_det_${rt[0]}$${rk}$",test_${ct[0]}$${ck}$_complex_determinant)]
         #: endfor
 
-        call cpu_time(t1)
-
-        print 1, 1000*(t1-t0), merge('SUCCESS','ERROR  ',.not.error)
-
-        1 format('Determinant tests completed in ',f9.4,' milliseconds, result=',a)
-
     end subroutine test_matrix_determinant
 
     !> Determinant of identity matrix
-    #:for rk,rt,ri in ALL_KINDS_TYPES
-    subroutine test_${ri}$_eye_determinant(error)
-        logical, intent(out) :: error
+    #:for rk,rt in RC_KINDS_TYPES
+    subroutine test_${rt[0]}$${rk}$_eye_determinant(error)
+        type(error_type), allocatable, intent(out) :: error
 
-        type(linalg_state) :: state
+        type(linalg_state_type) :: state
 
         integer(ilp) :: i
         integer(ilp), parameter :: n = 128_ilp
@@ -52,16 +47,19 @@ module test_linalg_determinant
 
         !> Determinant function
         deta = det(a,err=state)
-        error = state%error() .or. .not.abs(deta-1.0_${rk}$)<tiny(0.0_${rk}$)
-        if (error) return
-
-    end subroutine test_${ri}$_eye_determinant
+        
+        call check(error,state%ok(),state%print())
+        if (allocated(error)) return
+        
+        call check(error, abs(deta-1.0_${rk}$)<tiny(0.0_${rk}$), 'det(eye(n))==1')
+        
+    end subroutine test_${rt[0]}$${rk}$_eye_determinant
 
     !> Determinant of identity matrix multiplier
-    subroutine test_${ri}$_eye_multiple(error)
-        logical, intent(out) :: error
+    subroutine test_${rt[0]}$${rk}$_eye_multiple(error)
+        type(error_type), allocatable, intent(out) :: error
 
-        type(linalg_state) :: state
+        type(linalg_state_type) :: state
 
         integer(ilp), parameter :: n = 10_ilp
         real(${rk}$), parameter :: coef = 0.0001_${rk}$
@@ -76,19 +74,22 @@ module test_linalg_determinant
 
         !> Determinant: small, but a is not singular, because it is a multiple of the identity.
         deta = det(a,err=state)
-        error = state%error() .or. .not.abs(deta-coef**n)<max(tiny(0.0_${rk}$),epsilon(0.0_${rk}$)*coef**n)
-        if (error) return
+        call check(error,state%ok(),state%print())
+        if (allocated(error)) return
+        
+        call check(error, abs(deta-coef**n)<max(tiny(0.0_${rk}$),epsilon(0.0_${rk}$)*coef**n), &
+                         'det(0.0001*eye(n))==0.0001^n')
 
-    end subroutine test_${ri}$_eye_multiple
+    end subroutine test_${rt[0]}$${rk}$_eye_multiple
 
     #:endfor
 
     !> Determinant of complex identity matrix
-    #:for ck,ct,ci in CMPL_KINDS_TYPES
-    subroutine test_${ci}$_complex_determinant(error)
-        logical, intent(out) :: error
+    #:for ck,ct in CMPLX_KINDS_TYPES
+    subroutine test_${ct[0]}$${ck}$_complex_determinant(error)
+        type(error_type), allocatable, intent(out) :: error
 
-        type(linalg_state) :: state
+        type(linalg_state_type) :: state
 
         integer(ilp) :: i,j,n
         integer(ilp), parameter :: nmax = 10_ilp
@@ -116,12 +117,40 @@ module test_linalg_determinant
 
         end do matrix_size
 
-        error = state%error() .or. any(.not.abs(res-deta)<=tiny(0.0_${ck}$))
+        call check(error,state%ok(),state%print())
+        if (allocated(error)) return
+        
+        call check(error, all(abs(res-deta)<=tiny(0.0_${ck}$)), &
+                         'det((1+i)*eye(n))  does not match result')
 
-    end subroutine test_${ci}$_complex_determinant
+    end subroutine test_${ct[0]}$${ck}$_complex_determinant
 
     #:endfor
 
 end module test_linalg_determinant
 
-
+program test_det
+    use, intrinsic :: iso_fortran_env, only : error_unit
+    use testdrive, only : run_testsuite, new_testsuite, testsuite_type
+    use test_linalg_determinant, only : test_matrix_determinant
+    implicit none
+    integer :: stat, is
+    type(testsuite_type), allocatable :: testsuites(:)
+    character(len=*), parameter :: fmt = '("#", *(1x, a))'
+
+    stat = 0
+
+    testsuites = [ &
+        new_testsuite("linalg_determinant", test_matrix_determinant) &
+        ]
+
+    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