Homec4science
Diffusion COSOlver (improved_sugama) Browse

cosolver/basis_transformation/src/cocaunit.f90.in
cd1286e2d410improved_sugama

Last Change
Raw File

cocaunit.f90.in
View Options

!> @brief Provides assertion methods used within the COCA framework
!! @details This module allows one to perform assertions given input and
!! expectation variables. It also defines the CCTest structure, which holds
!! informations relative to a given test suite.
module COCAunit
use iso_fortran_env, only: REAL@PRECN@
implicit none
public
!> Kind of the real variables used by the module
integer, private, parameter :: cp = REAL@PRECN@
!> Structure holding informations about a test suite
type CCTest
!> Name of the test suite
character(len=128) :: test_name = "noname"
!> @var int ntest
!! @brief Number of tests run
!> @var int nftest
!! @brief Number of failed tests in the suite
integer :: ntest = 0, nftest = 0
contains
procedure :: Print_Init => Print_CCT_Start
procedure :: Print_Summarize => Print_CCT_Stop
end type CCTest
private :: Print_CCT_Start, Print_CCT_Stop
contains
!> Checks if two input variables are equal up to a given margin of error.
!! @param[inout] cct CCTest variable in which the result of the assertion is stored.
!! @param[in] input Input variable to check against expected value
!! @param[in] expect Expected value of input
!! @param[in] crit Indicates whether the test is critical and must be stopped if the assertion is false.
!! @param[in] errmsg Error message to print if the assertion fails.
!! @param[in] margin Margin of error within which input variables are considered equal. Zero by default
subroutine assert_equal( cct, input, expect, crit, errmsg, margin )
use iso_fortran_env, only: error_unit
implicit none
type( CCTest ), intent(in out) :: cct
real(cp), intent(in) :: input, expect
logical, intent(in) :: crit
character(*), intent(in) :: errmsg
real(cp), intent(in), optional :: margin
character(1024) :: msg
real(cp) :: amargin
amargin = 0._cp
if(present(margin)) amargin = margin
cct%ntest = cct%ntest + 1
write(msg,"(2(A,E20.13),A)") "Expected ", expect, &
& ", got ", input, "!"
if( len_trim(errmsg) /= 0 ) msg = errmsg
if( .not. abs(input-expect) <= amargin ) then
write(error_unit,"(4A)") "==[", trim(cct%test_name), &
& "]== ", trim(msg)
cct%nftest = cct%nftest + 1
if( crit ) call assert_abort( cct )
end if
end subroutine assert_equal
!> This routine is called in case of an aborted assertion (ie. failed
!! critical assertion). It prints a summary of the test suite and exits.
subroutine assert_abort( cct )
implicit none
type(CCTest), intent(in) :: cct
call cct%Print_Summarize()
stop 1
end subroutine assert_abort
!> Prints a header to the test suite
subroutine Print_CCT_Start( this )
use iso_fortran_env, only: error_unit
implicit none
class( CCTest ) :: this
integer :: framelen
framelen = 20
write(error_unit,"(3A)") "+", repeat("=",framelen), "+"
write(error_unit,"(2A)") "== TEST - ", trim(this%test_name)
write(error_unit,"(3A)") "+", repeat("=",framelen), "+"
end subroutine Print_CCT_Start
!> Prints a summary to the test suite.
subroutine Print_CCT_Stop( this )
use iso_fortran_env, only: error_unit
implicit none
class( CCTest ) :: this
integer :: framelen
framelen = 20
write(error_unit,"(3A)") "+", repeat("=",framelen), "+"
write(error_unit,"(2A)") "== TEST - ", trim(this%test_name)
write(error_unit,"(A)") "== SUMMARY "
write(error_unit,"(2(A,I3.1))") "== Failed tests: ", this%nftest, &
& "/", this%ntest
write(error_unit,"(3A)") "+", repeat("=",framelen), "+"
end subroutine Print_CCT_Stop
end module COCAunit
c4science · Help