From 4a5ecae744b63010b510dfda230278286253ffe6 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Sun, 13 Sep 2020 17:14:49 +0200 Subject: Allow selective testing of single suites and tests --- fpm/test/main.f90 | 99 +++++++++++++++++++++------ fpm/test/testsuite.f90 | 180 +++++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 239 insertions(+), 40 deletions(-) diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 index f9d0941..0e4f156 100644 --- a/fpm/test/main.f90 +++ b/fpm/test/main.f90 @@ -1,36 +1,97 @@ !> Driver for unit testing program fpm_testing use, intrinsic :: iso_fortran_env, only : error_unit - use testsuite, only : run_testsuite + use testsuite, only : run_testsuite, new_testsuite, testsuite_t, & + & select_suite, run_selected use test_toml, only : collect_toml use test_manifest, only : collect_manifest use test_source_parsing, only : collect_source_parsing implicit none - integer :: stat + integer :: stat, is + character(len=:), allocatable :: suite_name, test_name + type(testsuite_t), allocatable :: testsuite(:) character(len=*), parameter :: fmt = '("#", *(1x, a))' - write(error_unit, fmt) "Testing:", "fpm_toml" - call run_testsuite(collect_toml, error_unit, stat) + testsuite = [ & + & new_testsuite("fpm_toml", collect_toml), & + & new_testsuite("fpm_manifest", collect_manifest), & + & new_testsuite("fpm_source_parsing", collect_source_parsing) & + & ] - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "tests failed!" - error stop 1 - end if + call get_argument(1, suite_name) + call get_argument(2, test_name) + + if (allocated(suite_name)) then + is = select_suite(testsuite, suite_name) + if (is > 0 .and. is <= size(testsuite)) then + if (allocated(test_name)) then + write(error_unit, fmt) "Suite:", testsuite(is)%name + call run_selected(testsuite(is)%collect, test_name, error_unit, stat) + if (stat == -1) then + error stop 1 + end if + else + write(error_unit, fmt) "Testing:", testsuite(is)%name + call run_testsuite(testsuite(is)%collect, error_unit, stat) + end if - write(error_unit, fmt) "Testing:", "fpm_manifest" - call run_testsuite(collect_manifest, error_unit, stat) + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop 1 + end if + else + write(error_unit, fmt) "Available testsuites" + do is = 1, size(testsuite) + write(error_unit, fmt) "-", testsuite(is)%name + end do + error stop 1 + end if + else + do is = 1, size(testsuite) + write(error_unit, fmt) "Testing:", testsuite(is)%name + call run_testsuite(testsuite(is)%collect, error_unit, stat) - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "tests failed!" - error stop 1 + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop 1 + end if + end do end if - write(error_unit, fmt) "Testing:", "fpm_sources (parsing)" - call run_testsuite(collect_source_parsing, error_unit, stat) - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "tests failed!" - error stop 1 - end if +contains + + + !> Obtain the command line argument at a given index + subroutine get_argument(idx, arg) + + !> Index of command line argument, range [0:command_argument_count()] + integer, intent(in) :: idx + + !> Command line argument + character(len=:), allocatable, intent(out) :: arg + + integer :: length, stat + + call get_command_argument(idx, length=length, status=stat) + if (stat /= 0) then + return + endif + + allocate(character(len=length) :: arg, stat=stat) + if (stat /= 0) then + return + endif + + if (length > 0) then + call get_command_argument(idx, arg, status=stat) + if (stat /= 0) then + deallocate(arg) + return + end if + end if + + end subroutine get_argument + end program fpm_testing diff --git a/fpm/test/testsuite.f90 b/fpm/test/testsuite.f90 index 9b69032..4e46217 100644 --- a/fpm/test/testsuite.f90 +++ b/fpm/test/testsuite.f90 @@ -4,9 +4,10 @@ module testsuite implicit none private - public :: run_testsuite, new_unittest, test_failed + public :: run_testsuite, run_selected, new_unittest, new_testsuite, test_failed + public :: select_test, select_suite public :: check_string - public :: unittest_t, error_t + public :: unittest_t, testsuite_t, error_t abstract interface @@ -48,6 +49,22 @@ module testsuite end interface + !> Collection of unit tests + type :: testsuite_t + + !> Name of the testsuite + character(len=:), allocatable :: name + + !> Entry point of the test + procedure(collect_interface), pointer, nopass :: collect => null() + + end type testsuite_t + + + character(len=*), parameter :: fmt = '("#", *(1x, a))' + character(len=*), parameter :: indent = repeat(" ", 5) // repeat(".", 3) + + contains @@ -64,9 +81,6 @@ contains integer, intent(out) :: stat type(unittest_t), allocatable :: testsuite(:) - character(len=*), parameter :: fmt = '("#", *(1x, a))' - character(len=*), parameter :: indent = repeat(" ", 5) // repeat(".", 3) - type(error_t), allocatable :: error integer :: ii stat = 0 @@ -76,27 +90,133 @@ contains do ii = 1, size(testsuite) write(unit, '("#", 3(1x, a), 1x, "(", i0, "/", i0, ")")') & & "Starting", testsuite(ii)%name, "...", ii, size(testsuite) - call testsuite(ii)%test(error) - if (allocated(error) .neqv. testsuite(ii)%should_fail) then - if (testsuite(ii)%should_fail) then - write(unit, fmt) indent, testsuite(ii)%name, "[UNEXPECTED PASS]" - else - write(unit, fmt) indent, testsuite(ii)%name, "[FAILED]" - end if - stat = stat + 1 + call run_unittest(testsuite(ii), unit, stat) + end do + + end subroutine run_testsuite + + + !> Driver for selective testing + subroutine run_selected(collect, name, unit, stat) + + !> Collect tests + procedure(collect_interface) :: collect + + !> Name of the selected test + character(len=*), intent(in) :: name + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(out) :: stat + + type(unittest_t), allocatable :: testsuite(:) + integer :: ii + + stat = 0 + + call collect(testsuite) + + ii = select_test(testsuite, name) + + if (ii > 0 .and. ii <= size(testsuite)) then + call run_unittest(testsuite(ii), unit, stat) + else + write(unit, fmt) "Available tests:" + do ii = 1, size(testsuite) + write(unit, fmt) "-", testsuite(ii)%name + end do + stat = -1 + end if + + end subroutine run_selected + + + !> Run a selected unit test + subroutine run_unittest(test, unit, stat) + + !> Unit test + type(unittest_t), intent(in) :: test + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(inout) :: stat + + type(error_t), allocatable :: error + + call test%test(error) + if (allocated(error) .neqv. test%should_fail) then + if (test%should_fail) then + write(unit, fmt) indent, test%name, "[UNEXPECTED PASS]" else - if (testsuite(ii)%should_fail) then - write(unit, fmt) indent, testsuite(ii)%name, "[EXPECTED FAIL]" - else - write(unit, fmt) indent, testsuite(ii)%name, "[PASSED]" - end if + write(unit, fmt) indent, test%name, "[FAILED]" end if - if (allocated(error)) then - write(unit, fmt) "Message:", error%message + stat = stat + 1 + else + if (test%should_fail) then + write(unit, fmt) indent, test%name, "[EXPECTED FAIL]" + else + write(unit, fmt) indent, test%name, "[PASSED]" + end if + end if + if (allocated(error)) then + write(unit, fmt) "Message:", error%message + end if + + end subroutine run_unittest + + + !> Select a unit test from all available tests + function select_test(tests, name) result(pos) + + !> Name identifying the test suite + character(len=*), intent(in) :: name + + !> Available unit tests + type(unittest_t) :: tests(:) + + !> Selected test suite + integer :: pos + + integer :: it + + pos = 0 + do it = 1, size(tests) + if (name == tests(it)%name) then + pos = it + exit end if end do - end subroutine run_testsuite + end function select_test + + + !> Select a test suite from all available suites + function select_suite(suites, name) result(pos) + + !> Name identifying the test suite + character(len=*), intent(in) :: name + + !> Available test suites + type(testsuite_t) :: suites(:) + + !> Selected test suite + integer :: pos + + integer :: it + + pos = 0 + do it = 1, size(suites) + if (name == suites(it)%name) then + pos = it + exit + end if + end do + + end function select_suite !> Register a new unit test @@ -121,6 +241,24 @@ contains end function new_unittest + !> Register a new testsuite + function new_testsuite(name, collect) result(self) + + !> Name of the testsuite + character(len=*), intent(in) :: name + + !> Entry point to collect tests + procedure(collect_interface) :: collect + + !> Newly registered testsuite + type(testsuite_t) :: self + + self%name = name + self%collect => collect + + end function new_testsuite + + !> Check a deferred length character variable against a reference value subroutine check_string(error, actual, expected, name) -- cgit v1.2.3 From e969f5e675c832e3abbb9fb3db142c52ef0eb9d6 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Wed, 16 Sep 2020 07:44:42 +0200 Subject: Don't exit after failing in a test suite --- fpm/test/main.f90 | 19 ++++++++----------- fpm/test/testsuite.f90 | 10 +++------- 2 files changed, 11 insertions(+), 18 deletions(-) diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 index 0e4f156..bc8ad29 100644 --- a/fpm/test/main.f90 +++ b/fpm/test/main.f90 @@ -12,6 +12,8 @@ program fpm_testing type(testsuite_t), allocatable :: testsuite(:) character(len=*), parameter :: fmt = '("#", *(1x, a))' + stat = 0 + testsuite = [ & & new_testsuite("fpm_toml", collect_toml), & & new_testsuite("fpm_manifest", collect_manifest), & @@ -27,18 +29,13 @@ program fpm_testing if (allocated(test_name)) then write(error_unit, fmt) "Suite:", testsuite(is)%name call run_selected(testsuite(is)%collect, test_name, error_unit, stat) - if (stat == -1) then + if (stat < 0) then error stop 1 end if else write(error_unit, fmt) "Testing:", testsuite(is)%name call run_testsuite(testsuite(is)%collect, error_unit, stat) end if - - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" - error stop 1 - end if else write(error_unit, fmt) "Available testsuites" do is = 1, size(testsuite) @@ -50,14 +47,14 @@ program fpm_testing do is = 1, size(testsuite) write(error_unit, fmt) "Testing:", testsuite(is)%name call run_testsuite(testsuite(is)%collect, error_unit, stat) - - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" - error stop 1 - end if end do end if + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop 1 + end if + contains diff --git a/fpm/test/testsuite.f90 b/fpm/test/testsuite.f90 index 4e46217..124d19a 100644 --- a/fpm/test/testsuite.f90 +++ b/fpm/test/testsuite.f90 @@ -78,13 +78,11 @@ contains integer, intent(in) :: unit !> Number of failed tests - integer, intent(out) :: stat + integer, intent(inout) :: stat type(unittest_t), allocatable :: testsuite(:) integer :: ii - stat = 0 - call collect(testsuite) do ii = 1, size(testsuite) @@ -109,13 +107,11 @@ contains integer, intent(in) :: unit !> Number of failed tests - integer, intent(out) :: stat + integer, intent(inout) :: stat type(unittest_t), allocatable :: testsuite(:) integer :: ii - stat = 0 - call collect(testsuite) ii = select_test(testsuite, name) @@ -127,7 +123,7 @@ contains do ii = 1, size(testsuite) write(unit, fmt) "-", testsuite(ii)%name end do - stat = -1 + stat = -huge(ii) end if end subroutine run_selected -- cgit v1.2.3