Use character representable objects for failure details and test state

example/CMakeLists.txt

@@ -22,6 +22,7 @@ set_target_properties(
 target_sources(
   fortuno_example_testapp PRIVATE
   fixtured_tests.f90
+  parametrized_tests.f90
   simple_tests.f90
   testapp.f90
 )

example/fixtured_tests.f90

@@ -4,8 +4,9 @@
 
 module fixtured_tests
   use mylib, only : factorial
-  use fortuno_serial, only : check => serial_check, test => serial_case_item,&
-      & suite => serial_suite_item, serial_case_base, test_item
+  use fortuno_serial, only : char_rep_int, check => serial_check, is_equal, named_state,&
+      & named_item, suite => serial_suite_item, store_state => serial_store_state,&
+      & serial_case_base, test_item
   implicit none
 
   private
@@ -15,18 +16,14 @@ module fixtured_tests
   ! Fixtured test case creating a random number before running a test procedure.
   type, extends(serial_case_base) :: random_test_case
 
-    ! The random integer generated for a given test instance.
-    integer :: nn = -1
-
-    ! Test procedure to invoke once fixture had been created.
+  ! Test procedure to be invoked once fixture setup had been executed
     procedure(test_recursion_down), pointer, nopass :: proc
+
   contains
 
-    ! Overrides run procedure to execute fixture.
+    ! Overrides run procedure to set up fixture before test procedure is invoked.
     procedure :: run => random_test_case_run
 
-    !> Provides character representation of the internal state.
-    procedure :: get_as_char => random_test_case_get_as_char
   end type random_test_case
 
 contains
@@ -51,20 +48,18 @@ end function get_fixtured_tests
   ! TEST n! = n * (n - 1)!
   subroutine test_recursion_down(nn)
     integer, intent(in) :: nn
-    call check(factorial(nn) == nn * factorial(nn - 1))
+    call check(is_equal(factorial(nn), nn * factorial(nn - 1)))
   end subroutine test_recursion_down
 
 
   ! TEST (n + 1)! = (n + 1) * n!
   subroutine test_recursion_up(nn)
     integer, intent(in) :: nn
-    call check(factorial(nn + 1) == (nn  + 1) * factorial(nn))
-    ! Creating a "random" error to demonstrate failure reporting with internal state
-    call check(nn < 15)
+    call check(is_equal(factorial(nn + 1), (nn  + 1) * factorial(nn)))
   end subroutine test_recursion_up
 
 
-  ! Returns a random_test_case instance wrapped as test_item.
+  ! Convenience function returning a random_test_case instance wrapped as test_item.
   function random_test(name, proc) result(testitem)
     character(*), intent(in) :: name
     procedure(test_recursion_down) :: proc
@@ -75,32 +70,25 @@ function random_test(name, proc) result(testitem)
   end function random_test
 
 
-  ! Runs procedure of the random_test_case class.
+  ! Run procedure of the random_test_case class.
   subroutine random_test_case_run(this)
-    class(random_test_case), intent(inout) :: this
+    class(random_test_case), intent(in) :: this
 
     real :: rand
+    integer :: nn
 
     ! Set-up fixture by creating a random number
-    ! Number is stored as instance variable so that character representation of the internal state
-    ! can be obtained after test had been executed.
     call random_number(rand)
-    this%nn = int(20.0 * rand) + 1
-    call this%proc(this%nn)
+    ! Note: factorial(n) with n > 13 overflows with 32 bit integers
+    nn = int(13 * rand) + 1
+    ! Store internal state to aid introspection/identification later
+    call store_state(&
+        named_state([&
+            named_item("n", char_rep_int(nn))&
+        &])&
+    )
+    call this%proc(nn)
 
   end subroutine random_test_case_run
 
-
-  ! Returns representation of the internal state of a random_test_case_instance.
-  subroutine random_test_case_get_as_char(this, repr)
-    class(random_test_case), intent(in) :: this
-    character(:), allocatable, intent(out) :: repr
-
-    character(5) :: buffer
-
-    write(buffer, "(a3, i2.2)") "n: ", this%nn
-    repr = buffer
-
-  end subroutine random_test_case_get_as_char
-
 end module fixtured_tests

example/meson.build

@@ -15,6 +15,7 @@ example_testapp_exe = executable(
   'testapp',
   sources: [
     'fixtured_tests.f90',
+    'parametrized_tests.f90',
     'simple_tests.f90',
     'testapp.f90',
   ],

example/mylib.f90

@@ -26,6 +26,8 @@ function factorial(nn) result(fact)
     do ii = 2, nn
       fact = fact * ii
     end do
+    ! We create a "bug" which manifests only for certain input values
+    if (nn == 2 .or. nn > 10) fact = fact - 1
 
   end function factorial
 

example/parametrized_tests.f90

@@ -0,0 +1,70 @@
+! This file is part of Fortuno.
+! Licensed under the BSD-2-Clause Plus Patent license.
+! SPDX-License-Identifier: BSD-2-Clause-Patent
+
+module parametrized_tests
+  use mylib, only : factorial
+  use fortuno_serial, only : as_char, is_equal, serial_case_base, check => serial_check,&
+      & suite => serial_suite_item, test_item
+  implicit none
+
+  private
+  public :: get_parametrized_tests
+
+
+  !> Contains argument and expected result of a factorial() invokation
+  type :: arg_res
+    integer :: arg, res
+  end type
+
+  !> Argument/result pairs to check for
+  type(arg_res), parameter :: testcaseparams(*) = [&
+      & arg_res(1, 1), arg_res(2, 2), arg_res(3, 6), arg_res(4, 24), arg_res(5, 120)&
+      & ]
+
+
+  !> Parametrized test checking for an individual argument/result pair.
+  type, extends(serial_case_base) :: parametrized_test_case
+    type(arg_res) :: argres
+  contains
+    procedure :: run => parametrized_test_case_run
+  end type parametrized_test_case
+
+contains
+
+
+  !> Returns the tests of this module.
+  function get_parametrized_tests() result(testitems)
+    type(test_item), allocatable :: testitems(:)
+
+    integer :: ii
+
+    testitems = [&
+        suite("parametrized", [&
+            (parametrized_test("factorial", testcaseparams(ii)), ii = 1, size(testcaseparams))&
+        ])&
+    ]
+
+  end function get_parametrized_tests
+
+
+  !> Convenience wrapper to generate a test case for a given argres pair.
+  function parametrized_test(prefix, argres) result(testitem)
+    character(*), intent(in) :: prefix
+    type(arg_res), intent(in) :: argres
+    type(test_item) :: testitem
+
+    testitem%item = parametrized_test_case(name=prefix // "_" // as_char(argres%arg), argres=argres)
+
+  end function parametrized_test
+
+
+  !> Run method of the parametrized test (executing the check directly)
+  subroutine parametrized_test_case_run(this)
+    class(parametrized_test_case), intent(in) :: this
+
+    call check(is_equal(factorial(this%argres%arg), this%argres%res))
+
+  end subroutine parametrized_test_case_run
+
+end module parametrized_tests

example/simple_tests.f90

@@ -18,12 +18,12 @@ function get_simple_tests() result(testitems)
     type(test_item), allocatable :: testitems(:)
 
     testitems = [&
-        ! Adding a single test
+        ! Adding a single test not belonging to any test suite
         test("factorial_0", test_factorial_0),&
 
         ! Packing further tests into a suite in order to introduce more structure
         ! (e.g. running only tests being part of a given suite)
-        suite("mysuite", [&
+        suite("simple", [&
             test("factorial_1", test_factorial_1),&
             test("factorial_2", test_factorial_2)&
         ])&
@@ -41,14 +41,14 @@ subroutine test_factorial_1()
     call check(factorial(1) == 1)
   end subroutine test_factorial_1
 
-  ! Test: 2! = 2 (will fail to demonstrate the output of a failing test)
+  ! Test: 2! = 2 (will fail due to the bug in the implementation of the factorial function)
   subroutine test_factorial_2()
     ! Two failing checks, you should see info about both in the output
-    call check(is_equal(factorial(2), 3),&
+    call check(is_equal(factorial(2), 2),&
         & msg="Test failed for demonstration purposes",&
         & file="simple_tests.f90",&
-        & line=43)
-    call check(factorial(2) == 3)
+        & line=45)
+    call check(factorial(2) == 2)
   end subroutine test_factorial_2
 
 end module simple_tests

example/testapp.f90

@@ -7,12 +7,14 @@ program testapp
   use fortuno_serial, only : execute_serial_cmd_app
   use simple_tests, only : get_simple_tests
   use fixtured_tests, only : get_fixtured_tests
+  use parametrized_tests, only : get_parametrized_tests
   implicit none
 
   call execute_serial_cmd_app(&
     testitems=[&
       get_simple_tests(),&
-      get_fixtured_tests()&
+      get_fixtured_tests(),&
+      get_parametrized_tests()&
     ]&
   )
 

src/fortuno.f90

@@ -5,13 +5,14 @@
 !> Interface module for the core library of the Fortuno testing framework
 module fortuno
   use fortuno_basetypes, only : test_base, test_case_base, test_item, test_ptr_item, test_suite_base
+  use fortuno_chartypes, only : char_rep, char_rep_int, named_details, named_item, named_state
   use fortuno_consolelogger, only : console_logger
   use fortuno_testcontext, only : context_factory, test_context
   use fortuno_checkers, only : is_equal
   use fortuno_cmdapp, only : cmd_app
   use fortuno_testdriver, only : init_test_driver, test_driver, test_runner, test_selection
-  use fortuno_testinfo, only : check_result, drive_result, failure_details, failure_info,&
-      & failure_location, init_drive_result, init_failure_location, test_result, teststatus
+  use fortuno_testinfo, only : check_result, drive_result, failure_info, failure_location,&
+      & init_drive_result, init_failure_location, test_result, teststatus
   use fortuno_utils, only : as_char, nl
   implicit none
 

src/fortuno/CMakeLists.txt

@@ -6,6 +6,7 @@ target_sources(
   fortuno PRIVATE
   argumentparser.f90
   basetypes.f90
+  chartypes.f90
   checkers.f90
   cmdapp.f90
   consolelogger.f90

src/fortuno/argumentparser.f90

@@ -120,7 +120,7 @@ subroutine argument_parser_parse_args(this, argumentvalues, logger, exitcode)
 
     type(string), allocatable :: cmdargs(:), posargs(:)
     logical, allocatable :: processed(:)
-    character(:), allocatable :: argname, errormsg
+    character(:), allocatable :: argname
     integer :: nargs, nargdefs, iarg, iargdef
     logical optionsallowed, islong, matches
 

src/fortuno/basetypes.f90

@@ -20,10 +20,6 @@ module fortuno_basetypes
     !> Name of the generic test
     character(:), allocatable :: name
 
-  contains
-
-    procedure :: get_as_char => test_base_get_as_char
-
   end type test_base
 
 
@@ -58,18 +54,4 @@ module fortuno_basetypes
 
   end type test_suite_base
 
-contains
-
-
-  !> Delivers the character representation of the internal state of a test object
-  subroutine test_base_get_as_char(this, repr)
-
-    !> Instance
-    class(test_base), intent(in) :: this
-
-    !> Character representation, or **unallocated** on exit, if there is none
-    character(:), allocatable, intent(out) :: repr
-
-  end subroutine test_base_get_as_char
-
 end module fortuno_basetypes