Extend unit testing, handle exceptional values

Author: awvwgk

README.md

@@ -1,5 +1,9 @@
 # The simple testing framework
 
+[![Apache-2.0](https://img.shields.io/github/license/awvwgk/test-drive)](LICENSE)
+[![CI](https://github.com/awvwgk/test-drive/workflows/CI/badge.svg)](https://github.com/awvwgk/test-drive/actions)
+[![codecov](https://codecov.io/gh/awvwgk/test-drive/branch/main/graph/badge.svg)](https://codecov.io/gh/awvwgk/test-drive)
+
 This project offers a lightweight, procedural unit testing framework
 based on nothing but standard Fortran.
 

src/testdrive.f90

@@ -97,6 +97,7 @@
 !> For an example setup checkout the ``test/`` directory in this project.
 module testdrive
    use, intrinsic :: iso_fortran_env, only : error_unit
+   use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
    implicit none
    private
 
@@ -155,6 +156,8 @@ module testdrive
       module procedure :: check_logical
       module procedure :: check_float_sp
       module procedure :: check_float_dp
+      module procedure :: check_exceptional_sp
+      module procedure :: check_exceptional_dp
       module procedure :: check_int_i1
       module procedure :: check_int_i2
       module procedure :: check_int_i4
@@ -501,6 +504,9 @@ subroutine check_float_dp(error, actual, expected, message, more, thr, rel)
    logical :: relative
    real(dp) :: diff, threshold
 
+   call check(error, actual, message, more)
+   if (allocated(error)) return
+
    if (present(thr)) then
       threshold = thr
    else
@@ -542,6 +548,31 @@ subroutine check_float_dp(error, actual, expected, message, more, thr, rel)
 end subroutine check_float_dp
 
 
+subroutine check_exceptional_dp(error, actual, message, more)
+
+   !> Error handling
+   type(error_type), allocatable, intent(out) :: error
+
+   !> Found floating point value
+   real(dp), intent(in) :: actual
+
+   !> A detailed message describing the error
+   character(len=*), intent(in), optional :: message
+
+   !> Another line of error message
+   character(len=*), intent(in), optional :: more
+
+   if (ieee_is_nan(actual)) then
+      if (present(message)) then
+         call test_failed(error, message, more)
+      else
+         call test_failed(error, "Exceptional value 'not a number' found", more)
+      end if
+   end if
+
+end subroutine check_exceptional_dp
+
+
 subroutine check_float_sp(error, actual, expected, message, more, thr, rel)
 
    !> Error handling
@@ -568,6 +599,9 @@ subroutine check_float_sp(error, actual, expected, message, more, thr, rel)
    logical :: relative
    real(sp) :: diff, threshold
 
+   call check(error, actual, message, more)
+   if (allocated(error)) return
+
    if (present(thr)) then
       threshold = thr
    else
@@ -609,6 +643,31 @@ subroutine check_float_sp(error, actual, expected, message, more, thr, rel)
 end subroutine check_float_sp
 
 
+subroutine check_exceptional_sp(error, actual, message, more)
+
+   !> Error handling
+   type(error_type), allocatable, intent(out) :: error
+
+   !> Found floating point value
+   real(sp), intent(in) :: actual
+
+   !> A detailed message describing the error
+   character(len=*), intent(in), optional :: message
+
+   !> Another line of error message
+   character(len=*), intent(in), optional :: more
+
+   if (ieee_is_nan(actual)) then
+      if (present(message)) then
+         call test_failed(error, message, more)
+      else
+         call test_failed(error, "Exceptional value 'not a number' found", more)
+      end if
+   end if
+
+end subroutine check_exceptional_sp
+
+
 subroutine check_int_i1(error, actual, expected, message, more)
 
    !> Error handling

test/CMakeLists.txt

@@ -17,6 +17,7 @@
 set(
   tests
   "check"
+  "select"
 )
 set(
   test-srcs

test/main.f90

@@ -19,6 +19,7 @@ program tester
    use testdrive, only : run_testsuite, new_testsuite, testsuite_type, &
       & select_suite, run_selected, get_argument
    use test_check, only : collect_check
+   use test_select, only : collect_select
    implicit none
    integer :: stat, is
    character(len=:), allocatable :: suite_name, test_name
@@ -28,7 +29,8 @@ program tester
    stat = 0
 
    testsuites = [ &
-      new_testsuite("check", collect_check) &
+      new_testsuite("check", collect_check), &
+      new_testsuite("select", collect_select) &
       ]
 
    call get_argument(1, suite_name)

test/meson.build

@@ -14,7 +14,8 @@
 # limitations under the License.
 
 tests = [
-  'check'
+  'check',
+  'select',
 ]
 
 test_srcs = files(