From 58ef8896388385d0e79aedb49996367aeacdbb0c Mon Sep 17 00:00:00 2001
From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com>
Date: Wed, 2 Sep 2020 21:45:25 +0200
Subject: Add unit tests for fpm-fortran

---
 ci/run_tests.bat         |   3 +
 ci/run_tests.sh          |   1 +
 fpm/fpm.toml             |   5 ++
 fpm/test/main.f90        |  27 +++++++
 fpm/test/test_config.f90 | 188 +++++++++++++++++++++++++++++++++++++++++++++++
 fpm/test/test_toml.f90   |  95 ++++++++++++++++++++++++
 fpm/test/testsuite.f90   | 122 ++++++++++++++++++++++++++++++
 7 files changed, 441 insertions(+)
 create mode 100644 fpm/test/main.f90
 create mode 100644 fpm/test/test_config.f90
 create mode 100644 fpm/test/test_toml.f90
 create mode 100644 fpm/test/testsuite.f90

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
-- 
cgit v1.2.3