!-----------------------------------------------------------------------
! testing.f90 -- routines for unit testing
!-----------------------------------------------------------------------
!+ This file is part of the AENET package.
!+
!+ Copyright (C) 2012-2016 Nongnuch Artrith and Alexander Urban
!+
!+ This program is free software: you can redistribute it and/or modify
!+ it under the terms of the GNU General Public License as published by
!+ the Free Software Foundation, either version 3 of the License, or
!+ (at your option) any later version.
!+
!+ This program is distributed in the hope that it will be useful, but
!+ WITHOUT ANY WARRANTY; without even the implied warranty of
!+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
!+ General Public License for more details.
!+
!+ You should have received a copy of the GNU General Public License
!+ along with this program. If not, see <http://www.gnu.org/licenses/>.
!-----------------------------------------------------------------------
! 2014-09-24 Alexander Urban (AU), Nongnuch Artrith (NA)
!-----------------------------------------------------------------------
module unittest
use io, only: io_trim
implicit none
private
public :: tst_new, tst_check_passed, tst_assert_equal
integer, public :: tst_msg_len = 61
logical, public :: has_passed
logical, private :: has_EPS = .false.
interface tst_assert_equal
module procedure tst_assert_equal_d, tst_assert_equal_dn, &
tst_assert_equal_dn2, tst_assert_equal_dn3, &
tst_assert_equal_i, tst_assert_equal_in, &
tst_assert_equal_in2, tst_assert_equal_c, &
tst_assert_equal_cn, tst_assert_equal_cn2
end interface tst_assert_equal
contains
!--------------------------------------------------------------------!
! message describing the test without line break !
!--------------------------------------------------------------------!
subroutine tst_new(msg)
implicit none
character(len=*), intent(in) :: msg
write(*,'(1x,A,": ")', advance='no') io_trim(msg,tst_msg_len)
has_passed = .true.
end subroutine tst_new
!--------------------------------------------------------------------!
! print 'passed.' or 'FAILED!' depending on test !
!--------------------------------------------------------------------!
subroutine tst_check_passed(check)
implicit none
logical, optional, intent(in) :: check
if (present(check)) has_passed = (has_passed .and. check)
if (has_passed) then
write(*,*) 'passed.'
else
write(*,*) 'FAILED!'
end if
end subroutine tst_check_passed
!--------------------------------------------------------------------!
! assert equality !
!--------------------------------------------------------------------!
function tst_assert_equal_i(a, b) result(is_equal)
implicit none
integer, intent(in) :: a, b
logical :: is_equal
is_equal = (a == b)
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_i
!--------------------------------------------------------------------!
function tst_assert_equal_in(a, b) result(is_equal)
implicit none
integer, dimension(:), intent(in) :: a, b
logical :: is_equal
integer :: i, n
is_equal = .true.
if (size(a) /= size(b)) then
is_equal = .false.
has_passed = .false.
return
end if
n = size(a)
do i = 1, n
is_equal = (is_equal .and. tst_assert_equal_i(a(i), b(i)))
end do
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_in
!--------------------------------------------------------------------!
function tst_assert_equal_in2(a, b) result(is_equal)
implicit none
integer, dimension(:,:), intent(in) :: a, b
logical :: is_equal
integer :: i, n
is_equal = .true.
if (any(shape(a) /= shape(b))) then
is_equal = .false.
has_passed = .false.
return
end if
n = product(shape(a))
is_equal = (is_equal .and. &
tst_assert_equal_in(reshape(a,[n]), reshape(b,[n])))
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_in2
!--------------------------------------------------------------------!
function tst_assert_equal_d(a, b, prec, tol) result(is_equal)
implicit none
double precision, intent(in) :: a, b
double precision, optional, intent(in) :: prec
double precision, optional, intent(in) :: tol
double precision :: abs_diff
double precision :: largest
double precision :: eps
logical :: is_equal
if (present(tol)) then
eps = tol
else
! eps = epsilon(1.0d0)*1000.0d0
eps = 1.0d-10
end if
is_equal = (abs(a - b) <= abs(eps))
if ((.not. is_equal) .and. present(prec)) then
abs_diff = abs(a - b)
largest = max(abs(a), abs(b))
is_equal = (abs_diff <= largest*prec)
end if
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_d
!--------------------------------------------------------------------!
function tst_assert_equal_dn(a, b, prec, tol) result(is_equal)
implicit none
double precision, dimension(:), intent(in) :: a, b
double precision, optional, intent(in) :: prec
double precision, optional, intent(in) :: tol
integer :: i, n
logical :: is_equal
is_equal = .true.
if (size(a) /= size(b)) then
is_equal = .false.
has_passed = .false.
return
end if
n = size(a)
do i = 1, n
if (present(prec) .and. present(tol)) then
is_equal = (is_equal .and. tst_assert_equal_d(a(i), b(i), prec=prec, tol=tol))
else if (present(prec)) then
is_equal = (is_equal .and. tst_assert_equal_d(a(i), b(i), prec=prec))
else if (present(tol)) then
is_equal = (is_equal .and. tst_assert_equal_d(a(i), b(i), tol=tol))
else
is_equal = (is_equal .and. tst_assert_equal_d(a(i), b(i)))
end if
end do
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_dn
!--------------------------------------------------------------------!
function tst_assert_equal_dn2(a, b, prec, tol) result(is_equal)
implicit none
double precision, dimension(:,:), intent(in) :: a, b
double precision, optional, intent(in) :: prec
double precision, optional, intent(in) :: tol
integer :: n
logical :: is_equal
is_equal = .true.
if (any(shape(a) /= shape(b))) then
is_equal = .false.
has_passed = .false.
return
end if
n = product(shape(a))
if (present(prec) .and. present(tol)) then
is_equal = (is_equal .and. tst_assert_equal_dn(&
reshape(a,[n]), reshape(b,[n]), prec=prec, tol=tol))
else if (present(prec)) then
is_equal = (is_equal .and. tst_assert_equal_dn(&
reshape(a,[n]), reshape(b,[n]), prec=prec))
else if (present(tol)) then
is_equal = (is_equal .and. tst_assert_equal_dn(&
reshape(a,[n]), reshape(b,[n]), tol=tol))
else
is_equal = (is_equal .and. tst_assert_equal_dn(&
reshape(a,[n]), reshape(b,[n])))
end if
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_dn2
!--------------------------------------------------------------------!
function tst_assert_equal_dn3(a, b, prec, tol) result(is_equal)
implicit none
double precision, dimension(:,:,:), intent(in) :: a, b
double precision, optional, intent(in) :: prec
double precision, optional, intent(in) :: tol
integer :: n
logical :: is_equal
is_equal = .true.
if (any(shape(a) /= shape(b))) then
is_equal = .false.
has_passed = .false.
return
end if
n = product(shape(a))
if (present(prec) .and. present(tol)) then
is_equal = (is_equal .and. tst_assert_equal_dn(&
reshape(a,[n]), reshape(b,[n]), prec=prec, tol=tol))
else if (present(prec)) then
is_equal = (is_equal .and. tst_assert_equal_dn(&
reshape(a,[n]), reshape(b,[n]), prec=prec))
else if (present(tol)) then
is_equal = (is_equal .and. tst_assert_equal_dn(&
reshape(a,[n]), reshape(b,[n]), tol=tol))
else
is_equal = (is_equal .and. tst_assert_equal_dn(&
reshape(a,[n]), reshape(b,[n])))
end if
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_dn3
!--------------------------------------------------------------------!
function tst_assert_equal_c(a, b) result(is_equal)
implicit none
character(len=*), intent(in) :: a, b
logical :: is_equal
is_equal = (trim(a) == trim(b))
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_c
!--------------------------------------------------------------------!
function tst_assert_equal_cn(a, b) result(is_equal)
implicit none
character(len=*), dimension(:), intent(in) :: a, b
logical :: is_equal
integer :: i, n
is_equal = .true.
if (size(a) /= size(b)) then
is_equal = .false.
has_passed = .false.
return
end if
n = size(a)
do i = 1, n
is_equal = (is_equal .and. tst_assert_equal_c(a(i), b(i)))
end do
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_cn
!--------------------------------------------------------------------!
function tst_assert_equal_cn2(a, b) result(is_equal)
implicit none
character(len=*), dimension(:,:), intent(in) :: a, b
logical :: is_equal
integer :: i, n
is_equal = .true.
if (any(shape(a) /= shape(b))) then
is_equal = .false.
has_passed = .false.
return
end if
n = product(shape(a))
is_equal = (is_equal .and. &
tst_assert_equal_cn(reshape(a,[n]), reshape(b,[n])))
has_passed = (has_passed .and. is_equal)
end function tst_assert_equal_cn2
end module unittest
