diff options
| -rwxr-xr-x | ci/run_tests.bat | 3 | ||||
| -rwxr-xr-x | ci/run_tests.sh | 1 | ||||
| -rw-r--r-- | fpm/fpm.toml | 5 | ||||
| -rw-r--r-- | fpm/test/main.f90 | 27 | ||||
| -rw-r--r-- | fpm/test/test_config.f90 | 188 | ||||
| -rw-r--r-- | fpm/test/test_toml.f90 | 95 | ||||
| -rw-r--r-- | fpm/test/testsuite.f90 | 122 |
7 files changed, 441 insertions, 0 deletions
diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 99d0296..33d7071 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -9,6 +9,9 @@ if errorlevel 1 exit 1 fpm run if errorlevel 1 exit 1 +fpm test +if errorlevel 1 exit 1 + build\gfortran_debug\app\fpm if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 59724d5..c740cd8 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -5,6 +5,7 @@ set -ex cd fpm fpm build fpm run +fpm test build/gfortran_debug/app/fpm cd ../test/example_packages/hello_world ../../../fpm/build/gfortran_debug/app/fpm build diff --git a/fpm/fpm.toml b/fpm/fpm.toml index f07987d..9a0009f 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -7,3 +7,8 @@ copyright = "2020 fpm contributors" [dependencies] toml-f = { git = "https://github.com/toml-f/toml-f" } + +[[test]] +name = "fpm-test" +source-dir = "test" +main = "main.f90" diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 new file mode 100644 index 0000000..c4bfee5 --- /dev/null +++ b/fpm/test/main.f90 @@ -0,0 +1,27 @@ +!> Driver for unit testing +program fpm_testing + use, intrinsic :: iso_fortran_env, only : error_unit + use testsuite, only : run_testsuite + use test_toml, only : collect_toml + use test_config, only : collect_config + implicit none + integer :: stat + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + write(error_unit, fmt) "Testing:", "fpm_toml" + call run_testsuite(collect_toml, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "tests failed!" + error stop 1 + end if + + write(error_unit, fmt) "Testing:", "fpm_config" + call run_testsuite(collect_config, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "tests failed!" + error stop 1 + end if + +end program fpm_testing diff --git a/fpm/test/test_config.f90 b/fpm/test/test_config.f90 new file mode 100644 index 0000000..ecdf0a5 --- /dev/null +++ b/fpm/test/test_config.f90 @@ -0,0 +1,188 @@ +!> Define tests for the `fpm_config` modules +module test_config + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_config + implicit none + private + + public :: collect_config + + +contains + + + !> Collect all exported unit tests + subroutine collect_config(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("valid-config", test_valid_config), & + & new_unittest("invalid-config", test_invalid_config, should_fail=.true.), & + & new_unittest("default-library", test_default_library), & + & new_unittest("default-executable", test_default_executable)] + + end subroutine collect_config + + + !> Try to read some unnecessary obscure and convoluted but not invalid package file + subroutine test_valid_config(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: config = 'fpm-valid-config.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=config, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[dependencies.fpm]', & + & 'git = "https://github.com/fortran-lang/fpm"', & + & '[[executable]]', & + & 'name = "example-#1" # comment', & + & 'source-dir = "prog"', & + & '[dependencies]', & + & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & + & '"toml..f" = { path = ".." }', & + & '[["executable"]]', & + & 'name = "example-#2"', & + & 'source-dir = "prog"', & + & '[executable.dependencies]', & + & '[''library'']', & + & 'source-dir = """', & + & 'lib""" # comment' + close(unit) + + call get_package_data(package, config, error) + + open(file=config, newunit=unit) + close(unit, status='delete') + + if (allocated(error)) return + + if (package%name /= "example") then + call test_failed(error, "Package name is "//package%name//" but should be example") + return + end if + + if (.not.allocated(package%library)) then + call test_failed(error, "library is not present in package data") + return + end if + + if (.not.allocated(package%executable)) then + call test_failed(error, "executable is not present in package data") + return + end if + + if (size(package%executable) /= 2) then + call test_failed(error, "Number of executables in package is not two") + return + end if + + if (.not.allocated(package%dependency)) then + call test_failed(error, "dependency is not present in package data") + return + end if + + if (size(package%dependency) /= 3) then + call test_failed(error, "Number of dependencies in package is not three") + return + end if + + if (allocated(package%test)) then + call test_failed(error, "test is present in package but not in package file") + return + end if + + end subroutine test_valid_config + + + !> Try to read a valid TOML document which represent an invalid package file + subroutine test_invalid_config(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: config = 'fpm-invalid-config.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=config, newunit=unit) + write(unit, '(a)') & + & '[package]', & + & 'name = "example"', & + & 'version = "0.1.0"' + close(unit) + + call get_package_data(package, config, error) + + open(file=config, newunit=unit) + close(unit, status='delete') + + end subroutine test_invalid_config + + + !> Create a default library + subroutine test_default_library(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + + allocate(package%library) + call default_library(package%library) + + if (.not.allocated(package%library%source_dir)) then + call test_failed(error, "Default library source-dir is not set") + return + end if + + if (package%library%source_dir /= "src") then + call test_failed(error, "Default library source-dir is "// & + & package%library%source_dir//" but should be src") + return + end if + + end subroutine test_default_library + + + !> Create a default executable + subroutine test_default_executable(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: name = "default" + + allocate(package%executable(1)) + call default_executable(package%executable(1), name) + + if (.not.allocated(package%executable(1)%source_dir)) then + call test_failed(error, "Default executable source-dir is not set") + return + end if + + if (package%executable(1)%source_dir /= "app") then + call test_failed(error, "Default executable source-dir is "// & + & package%executable(1)%source_dir//" but should be app") + return + end if + + if (package%executable(1)%name /= name) then + call test_failed(error, "Default executable name is "// & + & package%executable(1)%name//" but should be "//name) + return + end if + + end subroutine test_default_executable + + +end module test_config diff --git a/fpm/test/test_toml.f90 b/fpm/test/test_toml.f90 new file mode 100644 index 0000000..8d57150 --- /dev/null +++ b/fpm/test/test_toml.f90 @@ -0,0 +1,95 @@ +!> Define tests for the `fpm_toml` modules +module test_toml + use testsuite, only : new_unittest, unittest_t, error_t + use fpm_toml + implicit none + private + + public :: collect_toml + + +contains + + + !> Collect all exported unit tests + subroutine collect_toml(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("valid-toml", test_valid_toml), & + & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.)] + + end subroutine collect_toml + + + !> Try to read some unnecessary obscure and convoluted but not invalid package file + subroutine test_valid_toml(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + character(len=*), parameter :: config = 'fpm-valid-toml.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=config, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[dependencies.fpm]', & + & 'git = "https://github.com/fortran-lang/fpm"', & + & '[[executable]]', & + & 'name = "example-#1" # comment', & + & 'source-dir = "prog"', & + & '[dependencies]', & + & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & + & '"toml..f" = { path = ".." }', & + & '[["executable"]]', & + & 'name = "example-#2"', & + & 'source-dir = "prog"', & + & '[executable.dependencies]', & + & '[''library'']', & + & 'source-dir = """', & + & 'lib""" # comment' + close(unit) + + call read_package_file(table, config, error) + + open(file=config, newunit=unit) + close(unit, status='delete') + + end subroutine test_valid_toml + + + !> Try to read an invalid TOML document + subroutine test_invalid_toml(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + character(len=*), parameter :: config = 'fpm-invalid-toml.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=config, newunit=unit) + write(unit, '(a)') & + & '# INVALID TOML DOC', & + & 'name = "example"', & + & 'dependencies.fpm.git = "https://github.com/fortran-lang/fpm"', & + & '[dependencies]', & + & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & + & '"toml..f" = { path = ".." }' + close(unit) + + call read_package_file(table, config, error) + + open(file=config, newunit=unit) + close(unit, status='delete') + + end subroutine test_invalid_toml + + +end module test_toml diff --git a/fpm/test/testsuite.f90 b/fpm/test/testsuite.f90 new file mode 100644 index 0000000..bd0d415 --- /dev/null +++ b/fpm/test/testsuite.f90 @@ -0,0 +1,122 @@ +!> Define some procedures to automate collecting and launching of tests +module testsuite + use fpm_error, only : error_t, test_failed => fatal_error + implicit none + private + + public :: run_testsuite, new_unittest, test_failed + public :: unittest_t, error_t + + + abstract interface + !> Entry point for tests + subroutine test_interface(error) + import :: error_t + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + end subroutine test_interface + end interface + + + !> Declaration of a unit test + type :: unittest_t + + !> Name of the test + character(len=:), allocatable :: name + + !> Entry point of the test + procedure(test_interface), pointer, nopass :: test => null() + + !> Whether test is supposed to fail + logical :: should_fail = .false. + + end type unittest_t + + + abstract interface + !> Collect all tests + subroutine collect_interface(testsuite) + import :: unittest_t + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + end subroutine collect_interface + end interface + + +contains + + + !> Driver for testsuite + subroutine run_testsuite(collect, unit, stat) + + !> Collect tests + procedure(collect_interface) :: collect + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + 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 + + call collect(testsuite) + + do ii = 1, size(testsuite) + write(unit, '("#", *(1x, a))') "Starting", testsuite(ii)%name, "..." + 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 + 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 + end if + if (allocated(error)) then + write(unit, '(a)') error%message + end if + end do + + end subroutine run_testsuite + + + !> Register a new unit test + function new_unittest(name, test, should_fail) result(self) + + !> Name of the test + character(len=*), intent(in) :: name + + !> Entry point for the test + procedure(test_interface) :: test + + !> Whether test is supposed to error or not + logical, intent(in), optional :: should_fail + + !> Newly registered test + type(unittest_t) :: self + + self%name = name + self%test => test + if (present(should_fail)) self%should_fail = should_fail + + end function new_unittest + + +end module testsuite |