diff options
| -rwxr-xr-x | ci/run_tests.bat | 3 | ||||
| -rwxr-xr-x | ci/run_tests.sh | 1 | ||||
| -rw-r--r-- | fpm/fpm.toml | 10 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 66 | ||||
| -rw-r--r-- | fpm/src/fpm/error.f90 | 58 | ||||
| -rw-r--r-- | fpm/src/fpm/git.f90 | 170 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest.f90 | 79 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/dependency.f90 | 246 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/executable.f90 | 177 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/library.f90 | 126 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/package.f90 | 275 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/test.f90 | 170 | ||||
| -rw-r--r-- | fpm/src/fpm/toml.f90 | 66 | ||||
| -rw-r--r-- | fpm/src/fpm_manifest.f90 | 10 | ||||
| -rw-r--r-- | fpm/src/fpm_model.f90 | 4 | ||||
| -rw-r--r-- | fpm/test/main.f90 | 27 | ||||
| -rw-r--r-- | fpm/test/test_manifest.f90 | 320 | ||||
| -rw-r--r-- | fpm/test/test_toml.f90 | 107 | ||||
| -rw-r--r-- | fpm/test/testsuite.f90 | 122 |
19 files changed, 2007 insertions, 30 deletions
diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 482cf79..ea50a70 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 e046910..0d9e7b1 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 c07eeba..b39d881 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -4,3 +4,13 @@ license = "MIT" author = "fpm maintainers" maintainer = "" copyright = "2020 fpm contributors" + +[dependencies] +[dependencies.toml-f] +git = "https://github.com/toml-f/toml-f" +rev = "290ba87671ab593e7bd51599e1d80ea736b3cd36" + +[[test]] +name = "fpm-test" +source-dir = "test" +main = "main.f90" diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 5e27701..86f9983 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,12 +1,14 @@ module fpm +use fpm_strings, only: string_t, str_ends_with use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS use fpm_filesystem, only: number_of_rows, list_files, exists -use fpm_manifest, only: fpm_manifest_t use fpm_model, only: build_model, fpm_model_t - +use fpm_manifest, only : get_package_data, default_executable, default_library, & + & package_t +use fpm_error, only : error_t implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test @@ -15,28 +17,56 @@ public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test contains -subroutine package_name(name) -character(:), allocatable, intent(out) :: name -! Currrently a heuristic. We should update this to read the name from fpm.toml -if (exists("src/fpm.f90")) then - name = "fpm" -else - name = "hello_world" -end if -end subroutine - subroutine cmd_build(settings) - type(fpm_build_settings), intent(in) :: settings +type(fpm_build_settings), intent(in) :: settings +type(package_t) :: package +type(error_t), allocatable :: error +type(string_t), allocatable :: files(:) +character(:), allocatable :: basename, linking +integer :: i, n +call get_package_data(package, "fpm.toml", error) +if (allocated(error)) then + print '(a)', error%message + error stop 1 +end if - type(fpm_manifest_t) :: manifest - type(fpm_model_t) :: model +! Populate library in case we find the default src directory +if (.not.allocated(package%library) .and. exists("src")) then + call default_library(package%library) +end if - print *, "# Building project" +! Populate executable in case we find the default app directory +if (.not.allocated(package%executable) .and. exists("app")) then + allocate(package%executable(1)) + call default_executable(package%executable(1), package%name) +end if - call build_model(model, settings, manifest) +if (.not.(allocated(package%library) .or. allocated(package%executable))) then + print '(a)', "Neither library nor executable found, there is nothing to do" + error stop 1 +end if - call build_package(model) +linking = "" +if (allocated(package%library)) then + call list_files(package%library%source_dir, files) + do i = 1, size(files) + if (str_ends_with(files(i)%s, ".f90")) then + n = len(files(i)%s) + basename = files(i)%s + call run("gfortran -c " // package%library%source_dir // "/" // & + & basename // " -o " // basename // ".o") + linking = linking // " " // basename // ".o" + end if + end do +end if +do i = 1, size(package%executable) + basename = package%executable(i)%main + call run("gfortran -c " // package%executable(i)%source_dir // "/" // & + & basename // " -o " // basename // ".o") + call run("gfortran " // basename // ".o " // linking // " -o " // & + & package%executable(i)%name) +end do end subroutine subroutine cmd_install() diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 new file mode 100644 index 0000000..aebd7e4 --- /dev/null +++ b/fpm/src/fpm/error.f90 @@ -0,0 +1,58 @@ +!> Implementation of basic error handling. +module fpm_error + implicit none + private + + public :: error_t + public :: fatal_error, syntax_error, file_not_found_error + + + !> Data type defining an error + type :: error_t + + !> Error message + character(len=:), allocatable :: message + + end type error_t + + + !> Alias syntax errors to fatal errors for now + interface syntax_error + module procedure :: fatal_error + end interface syntax_error + + +contains + + + !> Generic fatal runtime error + subroutine fatal_error(error, message) + + !> Instance of the error data + type(error_t), allocatable, intent(out) :: error + + !> Error message + character(len=*), intent(in) :: message + + allocate(error) + error%message = message + + end subroutine fatal_error + + + !> Error created when a file is missing or not found + subroutine file_not_found_error(error, file_name) + + !> Instance of the error data + type(error_t), allocatable, intent(out) :: error + + !> Name of the missing file + character(len=*), intent(in) :: file_name + + allocate(error) + error%message = "'"//file_name//"' could not be found, check if the file exists" + + end subroutine file_not_found_error + + +end module fpm_error diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 new file mode 100644 index 0000000..28ae867 --- /dev/null +++ b/fpm/src/fpm/git.f90 @@ -0,0 +1,170 @@ +!> Implementation for interacting with git repositories. +module fpm_git + implicit none + + public :: git_target_t + public :: git_target_default, git_target_branch, git_target_tag, & + & git_target_revision + + + !> Possible git target + type :: enum_descriptor + + !> Default target + integer :: default = 200 + + !> Branch in git repository + integer :: branch = 201 + + !> Tag in git repository + integer :: tag = 202 + + !> Commit hash + integer :: revision = 203 + + end type enum_descriptor + + !> Actual enumerator for descriptors + type(enum_descriptor), parameter :: git_descriptor = enum_descriptor() + + + !> Description of an git target + type :: git_target_t + private + + !> Kind of the git target + integer :: descriptor = git_descriptor%default + + !> Target URL of the git repository + character(len=:), allocatable :: url + + !> Additional descriptor of the git object + character(len=:), allocatable :: object + + contains + + !> Show information on instance + procedure :: info + + end type git_target_t + + +contains + + + !> Default target + function git_target_default(url) result(self) + + !> Target URL of the git repository + character(len=*), intent(in) :: url + + !> New git target + type(git_target_t) :: self + + self%descriptor = git_descriptor%default + self%url = url + + end function git_target_default + + + !> Target a branch in the git repository + function git_target_branch(url, branch) result(self) + + !> Target URL of the git repository + character(len=*), intent(in) :: url + + !> Name of the branch of interest + character(len=*), intent(in) :: branch + + !> New git target + type(git_target_t) :: self + + self%descriptor = git_descriptor%branch + self%url = url + self%object = branch + + end function git_target_branch + + + !> Target a specific git revision + function git_target_revision(url, sha1) result(self) + + !> Target URL of the git repository + character(len=*), intent(in) :: url + + !> Commit hash of interest + character(len=*), intent(in) :: sha1 + + !> New git target + type(git_target_t) :: self + + self%descriptor = git_descriptor%revision + self%url = url + self%object = sha1 + + end function git_target_revision + + + !> Target a git tag + function git_target_tag(url, tag) result(self) + + !> Target URL of the git repository + character(len=*), intent(in) :: url + + !> Tag name of interest + character(len=*), intent(in) :: tag + + !> New git target + type(git_target_t) :: self + + self%descriptor = git_descriptor%tag + self%url = url + self%object = tag + + end function git_target_tag + + + !> Show information on git target + subroutine info(self, unit, verbosity) + + !> Instance of the git target + class(git_target_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Git target" + if (allocated(self%url)) then + write(unit, fmt) "- URL", self%url + end if + if (allocated(self%object)) then + select case(self%descriptor) + case default + write(unit, fmt) "- object", self%object + case(git_descriptor%tag) + write(unit, fmt) "- tag", self%object + case(git_descriptor%branch) + write(unit, fmt) "- branch", self%object + case(git_descriptor%revision) + write(unit, fmt) "- sha1", self%object + end select + end if + + end subroutine info + + +end module fpm_git diff --git a/fpm/src/fpm/manifest.f90 b/fpm/src/fpm/manifest.f90 new file mode 100644 index 0000000..af4e0fa --- /dev/null +++ b/fpm/src/fpm/manifest.f90 @@ -0,0 +1,79 @@ +!> Package configuration data. +! +! This module provides the necessary procedure to translate a TOML document +! to the corresponding Fortran type, while verifying it with respect to +! its schema. +! +! Additionally, the required data types for users of this module are reexported +! to hide the actual implementation details. +module fpm_manifest + use fpm_manifest_executable, only : executable_t + use fpm_manifest_library, only : library_t + use fpm_manifest_package, only : package_t, new_package + use fpm_error, only : error_t, fatal_error, file_not_found_error + use fpm_toml, only : toml_table, read_package_file + implicit none + private + + public :: get_package_data, default_executable, default_library + public :: package_t + + +contains + + + !> Populate library in case we find the default src directory + subroutine default_library(self) + + !> Instance of the library meta data + type(library_t), intent(out) :: self + + self%source_dir = "src" + + end subroutine default_library + + + !> Populate executable in case we find the default app directory + subroutine default_executable(self, name) + + !> Instance of the executable meta data + type(executable_t), intent(out) :: self + + !> Name of the package + character(len=*), intent(in) :: name + + self%name = name + self%source_dir = "app" + self%main = "main.f90" + + end subroutine default_executable + + + !> Obtain package meta data from a configuation file + subroutine get_package_data(package, file, error) + + !> Parsed package meta data + type(package_t), intent(out) :: package + + !> Name of the package configuration file + character(len=*), intent(in) :: file + + !> Error status of the operation + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + + call read_package_file(table, file, error) + if (allocated(error)) return + + if (.not.allocated(table)) then + call fatal_error(error, "Unclassified error while reading: '"//file//"'") + return + end if + + call new_package(package, table, error) + + end subroutine get_package_data + + +end module fpm_manifest diff --git a/fpm/src/fpm/manifest/dependency.f90 b/fpm/src/fpm/manifest/dependency.f90 new file mode 100644 index 0000000..8a3d879 --- /dev/null +++ b/fpm/src/fpm/manifest/dependency.f90 @@ -0,0 +1,246 @@ +!> Implementation of the meta data for dependencies. +! +! A dependency table can currently have the following fields +! +! ```toml +! [dependencies] +! "dep1" = { git = "url" } +! "dep2" = { git = "url", branch = "name" } +! "dep3" = { git = "url", tag = "name" } +! "dep4" = { git = "url", rev = "sha1" } +! "dep0" = { path = "path" } +! ``` +! +! To reduce the amount of boilerplate code this module provides two constructors +! for dependency types, one basic for an actual dependency (inline) table +! and another to collect all dependency objects from a dependencies table, +! which is handling the allocation of the objects and is forwarding the +! individual dependency tables to their respective constructors. +! The usual entry point should be the constructor for the super table. +! +! This objects contains a target to retrieve required `fpm` projects to +! build the target declaring the dependency. +! Resolving a dependency will result in obtaining a new package configuration +! data for the respective project. +module fpm_manifest_dependency + use fpm_error, only : error_t, syntax_error + use fpm_git, only : git_target_t, git_target_tag, git_target_branch, & + & git_target_revision, git_target_default + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: dependency_t, new_dependency, new_dependencies + + + !> Configuration meta data for a dependency + type :: dependency_t + + !> Name of the dependency + character(len=:), allocatable :: name + + !> Local target + character(len=:), allocatable :: path + + !> Git descriptor + type(git_target_t), allocatable :: git + + contains + + !> Print information on this instance + procedure :: info + + end type dependency_t + + +contains + + + !> Construct a new dependency configuration from a TOML data structure + subroutine new_dependency(self, table, error) + + !> Instance of the dependency configuration + type(dependency_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: url, obj + + call check(table, error) + if (allocated(error)) return + + call table%get_key(self%name) + + call get_value(table, "path", url) + if (allocated(url)) then + call move_alloc(url, self%path) + else + call get_value(table, "git", url) + + call get_value(table, "tag", obj) + if (allocated(obj)) then + self%git = git_target_tag(url, obj) + end if + + if (.not.allocated(self%git)) then + call get_value(table, "branch", obj) + if (allocated(obj)) then + self%git = git_target_branch(url, obj) + end if + end if + + if (.not.allocated(self%git)) then + call get_value(table, "revision", obj) + if (allocated(obj)) then + self%git = git_target_revision(url, obj) + end if + end if + + if (.not.allocated(self%git)) then + self%git = git_target_default(url) + end if + + end if + + end subroutine new_dependency + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: name + type(toml_key), allocatable :: list(:) + logical :: url_present, git_target_present + integer :: ikey + + url_present = .false. + git_target_present = .false. + + call table%get_key(name) + call table%get_keys(list) + + if (size(list) < 1) then + call syntax_error(error, "Dependency "//name//" does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in dependency "//name) + exit + + case("git", "path") + if (url_present) then + call syntax_error(error, "Dependency "//name//" cannot have both git and path entries") + exit + end if + url_present = .true. + + case("branch", "rev", "tag") + if (git_target_present) then + call syntax_error(error, "Dependency "//name//" can only have one of branch, rev or tag present") + exit + end if + git_target_present = .true. + + end select + end do + if (allocated(error)) return + + if (.not.url_present) then + call syntax_error(error, "Dependency "//name//" does not provide a method to actually retrieve itself") + return + end if + + if (.not.url_present .and. git_target_present) then + call syntax_error(error, "Dependency "//name//" uses a local path, therefore no git identifiers are allowed") + end if + + end subroutine check + + + !> Construct new dependency array from a TOML data structure + subroutine new_dependencies(deps, table, error) + + !> Instance of the dependency configuration + type(dependency_t), allocatable, intent(out) :: deps(:) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: node + type(toml_key), allocatable :: list(:) + integer :: idep, stat + + call table%get_keys(list) + ! An empty table is okay + if (size(list) < 1) return + + allocate(deps(size(list))) + do idep = 1, size(list) + call get_value(table, list(idep)%key, node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Dependency "//list(idep)%key//" must be a table entry") + exit + end if + call new_dependency(deps(idep), node, error) + if (allocated(error)) exit + end do + + end subroutine new_dependencies + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the dependency configuration + class(dependency_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + write(unit, fmt) "Dependency" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + + if (allocated(self%git)) then + write(unit, fmt) "- kind", "git" + call self%git%info(unit, pr - 1) + end if + + if (allocated(self%path)) then + write(unit, fmt) "- kind", "local" + write(unit, fmt) "- path", self%path + end if + + end subroutine info + + +end module fpm_manifest_dependency diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 new file mode 100644 index 0000000..f706001 --- /dev/null +++ b/fpm/src/fpm/manifest/executable.f90 @@ -0,0 +1,177 @@ +!> Implementation of the meta data for an executables. +! +! An executable table can currently have the following fields +! +! ```toml +! [[executable]] +! name = "string" +! source-dir = "path" +! main = "file" +! [executable.dependencies] +! ``` +module fpm_manifest_executable + use fpm_manifest_dependency, only : dependency_t, new_dependencies + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: executable_t, new_executable + + + !> Configuation meta data for an executable + type :: executable_t + + !> Name of the resulting executable + character(len=:), allocatable :: name + + !> Source directory for collecting the executable + character(len=:), allocatable :: source_dir + + !> Name of the source file declaring the main program + character(len=:), allocatable :: main + + !> Dependency meta data for this executable + type(dependency_t), allocatable :: dependency(:) + + contains + + !> Print information on this instance + procedure :: info + + end type executable_t + + +contains + + + !> Construct a new executable configuration from a TOML data structure + subroutine new_executable(self, table, error) + + !> Instance of the executable configuration + type(executable_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + if (.not.allocated(self%name)) then + call syntax_error(error, "Could not retrieve executable name") + return + end if + call get_value(table, "source-dir", self%source_dir, "app") + call get_value(table, "main", self%main, "main.f90") + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + end subroutine new_executable + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_keys(list) + + if (size(list) < 1) then + call syntax_error(error, "Executable section does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed executable entry") + exit + + case("name") + name_present = .true. + + case("source-dir", "main", "dependencies") + continue + + end select + end do + + if (.not.name_present) then + call syntax_error(error, "Executable name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the executable configuration + class(executable_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Executable target" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + if (allocated(self%source_dir)) then + if (self%source_dir /= "app" .or. pr > 2) then + write(unit, fmt) "- source directory", self%source_dir + end if + end if + if (allocated(self%main)) then + if (self%main /= "main.f90" .or. pr > 2) then + write(unit, fmt) "- program source", self%main + end if + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_manifest_executable diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90 new file mode 100644 index 0000000..40e5e92 --- /dev/null +++ b/fpm/src/fpm/manifest/library.f90 @@ -0,0 +1,126 @@ +!> Implementation of the meta data for libraries. +! +! A library table can currently have the following fields +! +! ```toml +! [library] +! source-dir = "path" +! build-script = "file" +! ``` +module fpm_manifest_library + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: library_t, new_library + + + !> Configuration meta data for a library + type :: library_t + + !> Source path prefix + character(len=:), allocatable :: source_dir + + !> Alternative build script to be invoked + character(len=:), allocatable :: build_script + + contains + + !> Print information on this instance + procedure :: info + + end type library_t + + +contains + + + !> Construct a new library configuration from a TOML data structure + subroutine new_library(self, table, error) + + !> Instance of the library configuration + type(library_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "source-dir", self%source_dir, "src") + call get_value(table, "build-script", self%build_script) + + end subroutine new_library + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + integer :: ikey + + call table%get_keys(list) + + ! table can be empty + if (size(list) < 1) return + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") + exit + + case("source-dir", "build-script") + continue + + end select + end do + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the library configuration + class(library_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Library target" + if (allocated(self%source_dir)) then + write(unit, fmt) "- source directory", self%source_dir + end if + if (allocated(self%build_script)) then + write(unit, fmt) "- custom build", self%build_script + end if + + end subroutine info + + +end module fpm_manifest_library diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 new file mode 100644 index 0000000..4c2c14a --- /dev/null +++ b/fpm/src/fpm/manifest/package.f90 @@ -0,0 +1,275 @@ +!> Define the package data containing the meta data from the configuration file. +! +! The package data defines a Fortran type corresponding to the respective +! TOML document, after creating it from a package file no more interaction +! with the TOML document is required. +! +! Every configuration type provides it custom constructor (prefixed with `new_`) +! and knows how to deserialize itself from a TOML document. +! To ensure we find no untracked content in the package file all keywords are +! checked and possible entries have to be explicitly allowed in the `check` +! function. +! If entries are mutally exclusive or interdependent inside the current table +! the `check` function is required to enforce this schema on the data structure. +! +! The package file root allows the following keywords +! +! ```toml +! name = "string" +! version = "string" +! license = "string" +! author = "string" +! maintainer = "string" +! copyright = "string +! [library] +! [dependencies] +! [dev-dependencies] +! [[executable]] +! [[test]] +! ``` +module fpm_manifest_package + use fpm_manifest_dependency, only : dependency_t, new_dependencies + use fpm_manifest_executable, only : executable_t, new_executable + use fpm_manifest_library, only : library_t, new_library + use fpm_manifest_test, only : test_t, new_test + use fpm_error, only : error_t, fatal_error, syntax_error + use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, & + & len + implicit none + private + + public :: package_t, new_package + + + !> Package meta data + type :: package_t + + !> Name of the package + character(len=:), allocatable :: name + + !> Library meta data + type(library_t), allocatable :: library + + !> Executable meta data + type(executable_t), allocatable :: executable(:) + + !> Dependency meta data + type(dependency_t), allocatable :: dependency(:) + + !> Development dependency meta data + type(dependency_t), allocatable :: dev_dependency(:) + + !> Test meta data + type(test_t), allocatable :: test(:) + + contains + + !> Print information on this instance + procedure :: info + + end type package_t + + +contains + + + !> Construct a new package configuration from a TOML data structure + subroutine new_package(self, table, error) + + !> Instance of the package configuration + type(package_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child, node + class(toml_array), pointer :: children + integer :: ii, nn, stat + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + if (.not.allocated(self%name)) then + call syntax_error(error, "Could not retrieve package name") + return + end if + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + call get_value(table, "dev-dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dev_dependency, child, error) + if (allocated(error)) return + end if + + call get_value(table, "library", child, requested=.false.) + if (associated(child)) then + allocate(self%library) + call new_library(self%library, child, error) + if (allocated(error)) return + end if + + call get_value(table, "executable", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%executable(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve executable from array entry") + exit + end if + call new_executable(self%executable(ii), node, error) + if (allocated(error)) exit + end do + if (allocated(error)) return + end if + + call get_value(table, "test", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%test(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve test from array entry") + exit + end if + call new_test(self%test(ii), node, error) + if (allocated(error)) exit + end do + if (allocated(error)) return + end if + + end subroutine new_package + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_keys(list) + + if (size(list) < 1) then + call syntax_error(error, "Package file is empty") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") + exit + + case("name") + name_present = .true. + + case("version", "license", "author", "maintainer", "copyright", & + & "dependencies", "dev-dependencies", "test", "executable", & + & "library") + continue + + end select + end do + if (allocated(error)) return + + if (.not.name_present) then + call syntax_error(error, "Package name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the package configuration + class(package_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Package" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + + if (allocated(self%library)) then + write(unit, fmt) "- target", "archive" + call self%library%info(unit, pr - 1) + end if + + if (allocated(self%executable)) then + if (size(self%executable) > 1 .or. pr > 2) then + write(unit, fmti) "- executables", size(self%executable) + end if + do ii = 1, size(self%executable) + call self%executable(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%test)) then + if (size(self%test) > 1 .or. pr > 2) then + write(unit, fmti) "- tests", size(self%test) + end if + do ii = 1, size(self%test) + call self%test(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%dev_dependency)) then + if (size(self%dev_dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- development deps.", size(self%dev_dependency) + end if + do ii = 1, size(self%dev_dependency) + call self%dev_dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_manifest_package diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 new file mode 100644 index 0000000..a6c6f64 --- /dev/null +++ b/fpm/src/fpm/manifest/test.f90 @@ -0,0 +1,170 @@ +!> Implementation of the meta data for a test. +! +! The test data structure is effectively a decorated version of an executable +! and shares most of its properties, except for the defaults and can be +! handled under most circumstances just like any other executable. +! +! A test table can currently have the following fields +! +! ```toml +! [[test]] +! name = "string" +! source-dir = "path" +! main = "file" +! [test.dependencies] +! ``` +module fpm_manifest_test + use fpm_manifest_dependency, only : dependency_t, new_dependencies + use fpm_manifest_executable, only : executable_t + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: test_t, new_test + + + !> Configuation meta data for an test + type, extends(executable_t) :: test_t + + contains + + !> Print information on this instance + procedure :: info + + end type test_t + + +contains + + + !> Construct a new test configuration from a TOML data structure + subroutine new_test(self, table, error) + + !> Instance of the test configuration + type(test_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + if (.not.allocated(self%name)) then + call syntax_error(error, "Could not retrieve test name") + return + end if + call get_value(table, "source-dir", self%source_dir, "test") + call get_value(table, "main", self%main, "main.f90") + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + end subroutine new_test + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_keys(list) + + if (size(list) < 1) then + call syntax_error(error, "Test section does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in test entry") + exit + + case("name") + name_present = .true. + + case("source-dir", "main", "dependencies") + continue + + end select + end do + + if (.not.name_present) then + call syntax_error(error, "Test name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the test configuration + class(test_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Test target" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + if (allocated(self%source_dir)) then + if (self%source_dir /= "test" .or. pr > 2) then + write(unit, fmt) "- source directory", self%source_dir + end if + end if + if (allocated(self%main)) then + if (self%main /= "main.f90" .or. pr > 2) then + write(unit, fmt) "- test source", self%main + end if + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_manifest_test diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90 new file mode 100644 index 0000000..183278d --- /dev/null +++ b/fpm/src/fpm/toml.f90 @@ -0,0 +1,66 @@ +!> Interface to TOML processing library. +! +! This module acts as a proxy to the `toml-f` public Fortran API and allows +! to selectively expose components from the library to `fpm`. +! The interaction with `toml-f` data types outside of this module should be +! limited to tables, arrays and key-lists, most of the necessary interactions +! are implemented in the building interface with the `get_value` and `set_value` +! procedures. +! +! This module allows to implement features necessary for `fpm`, which are +! not yet available in upstream `toml-f`. +! +! For more details on the library used see: https://github.com/toml-f/toml-f +module fpm_toml + use fpm_error, only : error_t, fatal_error, file_not_found_error + use tomlf, only : toml_table, toml_array, toml_key, toml_stat, get_value, & + & toml_parse, toml_error + use tomlf_type, only : new_table, len + implicit none + private + + public :: read_package_file + public :: toml_table, toml_array, toml_key, toml_stat, get_value + public :: new_table, len + + +contains + + + !> Process the configuration file to a TOML data structure + subroutine read_package_file(table, manifest, error) + + !> TOML data structure + type(toml_table), allocatable, intent(out) :: table + + !> Name of the package configuration file + character(len=*), intent(in) :: manifest + + !> Error status of the operation + type(error_t), allocatable, intent(out) :: error + + type(toml_error), allocatable :: parse_error + integer :: unit + logical :: exist + + inquire(file=manifest, exist=exist) + + if (.not.exist) then + call file_not_found_error(error, manifest) + return + end if + + open(file=manifest, newunit=unit) + call toml_parse(table, unit, parse_error) + close(unit) + + if (allocated(parse_error)) then + allocate(error) + call move_alloc(parse_error%message, error%message) + return + end if + + end subroutine read_package_file + + +end module fpm_toml diff --git a/fpm/src/fpm_manifest.f90 b/fpm/src/fpm_manifest.f90 deleted file mode 100644 index 8b0add0..0000000 --- a/fpm/src/fpm_manifest.f90 +++ /dev/null @@ -1,10 +0,0 @@ -module fpm_manifest -! Parsing, validation and representation of 'fpm.toml' manifest file -implicit none - -type fpm_manifest_t - ! Encapsulates settings parsed from 'fpm.toml' - -end type fpm_manifest_t - -end module fpm_manifest
\ No newline at end of file diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index b519c87..12078b0 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -4,7 +4,7 @@ module fpm_model use fpm_command_line, only: fpm_build_settings use fpm_filesystem, only: exists -use fpm_manifest, only: fpm_manifest_t +use fpm_manifest, only: package_t use fpm_sources, only: resolve_dependencies, scan_sources, srcfile_t use fpm_strings, only: string_t @@ -35,7 +35,7 @@ subroutine build_model(model, settings, manifest) ! type(fpm_model_t), intent(out) :: model type(fpm_build_settings), intent(in) :: settings - type(fpm_manifest_t), intent(in) :: manifest + type(package_t), intent(in) :: manifest if (exists("src/fpm.f90")) then model%package_name = "fpm" diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 new file mode 100644 index 0000000..19bcdb6 --- /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_manifest, only : collect_manifest + 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_manifest" + call run_testsuite(collect_manifest, 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_manifest.f90 b/fpm/test/test_manifest.f90 new file mode 100644 index 0000000..7ad5e5a --- /dev/null +++ b/fpm/test/test_manifest.f90 @@ -0,0 +1,320 @@ +!> Define tests for the `fpm_manifest` modules +module test_manifest + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_manifest + implicit none + private + + public :: collect_manifest + + +contains + + + !> Collect all exported unit tests + subroutine collect_manifest(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("valid-manifest", test_valid_manifest), & + & new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), & + & new_unittest("default-library", test_default_library), & + & new_unittest("default-executable", test_default_executable), & + & new_unittest("dependency-empty", test_dependency_empty, should_fail=.true.), & + & new_unittest("dependencies-empty", test_dependencies_empty), & + & new_unittest("executable-empty", test_executable_empty, should_fail=.true.), & + & new_unittest("library-empty", test_library_empty), & + & new_unittest("package-empty", test_package_empty, should_fail=.true.), & + & new_unittest("test-empty", test_test_empty, should_fail=.true.)] + + end subroutine collect_manifest + + + !> Try to read some unnecessary obscure and convoluted but not invalid package file + subroutine test_valid_manifest(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: manifest = 'fpm-valid-manifest.toml' + integer :: unit + + open(file=manifest, 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, manifest, error) + + open(file=manifest, 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_manifest + + + !> Try to read a valid TOML document which represent an invalid package file + subroutine test_invalid_manifest(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: manifest = 'fpm-invalid-manifest.toml' + integer :: unit + + open(file=manifest, newunit=unit) + write(unit, '(a)') & + & '[package]', & + & 'name = "example"', & + & 'version = "0.1.0"' + close(unit) + + call get_package_data(package, manifest, error) + + open(file=manifest, newunit=unit) + close(unit, status='delete') + + end subroutine test_invalid_manifest + + + !> 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 + + + !> Dependencies cannot be created from empty tables + subroutine test_dependency_empty(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(dependency_t) :: dependency + + call new_table(table) + table%key = "example" + + call new_dependency(dependency, table, error) + + call dependency%info(0) + + end subroutine test_dependency_empty + + + !> Dependency tables can be empty + subroutine test_dependencies_empty(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(dependency_t), allocatable :: dependencies(:) + + call new_table(table) + + call new_dependencies(dependencies, table, error) + if (allocated(error)) return + + if (allocated(dependencies)) then + call test_failed(error, "Found dependencies in empty table") + end if + + end subroutine test_dependencies_empty + + + !> Executables cannot be created from empty tables + subroutine test_executable_empty(error) + use fpm_manifest_executable + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(executable_t) :: executable + + call new_table(table) + + call new_executable(executable, table, error) + + end subroutine test_executable_empty + + + !> Libraries can be created from empty tables + subroutine test_library_empty(error) + use fpm_manifest_library + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(library_t) :: library + + call new_table(table) + + call new_library(library, table, error) + if (allocated(error)) return + + if (.not.allocated(library%source_dir)) then + call test_failed(error, "Default library source-dir is not set") + return + end if + + if (library%source_dir /= "src") then + call test_failed(error, "Default library source-dir is "// & + & library%source_dir//" but should be src") + return + end if + + end subroutine test_library_empty + + + !> Packages cannot be created from empty tables + subroutine test_package_empty(error) + use fpm_manifest_package + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(package_t) :: package + + call new_table(table) + + call new_package(package, table, error) + + end subroutine test_package_empty + + + !> Tests cannot be created from empty tables + subroutine test_test_empty(error) + use fpm_manifest_test + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(test_t) :: test + + call new_table(table) + + call new_test(test, table, error) + + end subroutine test_test_empty + + +end module test_manifest diff --git a/fpm/test/test_toml.f90 b/fpm/test/test_toml.f90 new file mode 100644 index 0000000..ba48307 --- /dev/null +++ b/fpm/test/test_toml.f90 @@ -0,0 +1,107 @@ +!> 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.), & + & new_unittest("missing-file", test_missing_file, 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 :: manifest = 'fpm-valid-toml.toml' + integer :: unit + + open(file=manifest, 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, manifest, error) + + open(file=manifest, 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 :: manifest = 'fpm-invalid-toml.toml' + integer :: unit + + open(file=manifest, 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, manifest, error) + + open(file=manifest, newunit=unit) + close(unit, status='delete') + + end subroutine test_invalid_toml + + + !> Try to read configuration from a non-existing file + subroutine test_missing_file(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + + call read_package_file(table, 'low+chance+of+existing.toml', error) + + end subroutine test_missing_file + + +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 |