From 61780313dfc873f06973dd6e7a51e3004f4a7bd6 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Tue, 1 Sep 2020 22:48:32 +0200 Subject: Implement interface to TOML-Fortran and reading of fpm.toml --- fpm/fpm.toml | 3 + fpm/src/fpm.f90 | 70 ++++++---- fpm/src/fpm/config.f90 | 79 +++++++++++ fpm/src/fpm/config/dependency.f90 | 241 ++++++++++++++++++++++++++++++++++ fpm/src/fpm/config/executable.f90 | 173 ++++++++++++++++++++++++ fpm/src/fpm/config/library.f90 | 126 ++++++++++++++++++ fpm/src/fpm/config/package.f90 | 270 ++++++++++++++++++++++++++++++++++++++ fpm/src/fpm/config/test.f90 | 166 +++++++++++++++++++++++ fpm/src/fpm/error.f90 | 61 +++++++++ fpm/src/fpm/git.f90 | 170 ++++++++++++++++++++++++ fpm/src/fpm/toml.f90 | 65 +++++++++ 11 files changed, 1401 insertions(+), 23 deletions(-) create mode 100644 fpm/src/fpm/config.f90 create mode 100644 fpm/src/fpm/config/dependency.f90 create mode 100644 fpm/src/fpm/config/executable.f90 create mode 100644 fpm/src/fpm/config/library.f90 create mode 100644 fpm/src/fpm/config/package.f90 create mode 100644 fpm/src/fpm/config/test.f90 create mode 100644 fpm/src/fpm/error.f90 create mode 100644 fpm/src/fpm/git.f90 create mode 100644 fpm/src/fpm/toml.f90 diff --git a/fpm/fpm.toml b/fpm/fpm.toml index c07eeba..f07987d 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -4,3 +4,6 @@ license = "MIT" author = "fpm maintainers" maintainer = "" copyright = "2020 fpm contributors" + +[dependencies] +toml-f = { git = "https://github.com/toml-f/toml-f" } diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index ed80313..5123436 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,5 +1,8 @@ module fpm use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_config, 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 @@ -85,34 +88,55 @@ else end if end function -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() +type(package_t) :: package +type(error_t), allocatable :: error type(string_t), allocatable :: files(:) -character(:), allocatable :: basename, pkg_name, linking +character(:), allocatable :: basename, linking integer :: i, n -print *, "# Building project" -call list_files("src", files) +call get_package_data(package, "fpm.toml", error) +if (allocated(error)) then + print '(a)', error%message + error stop 1 +end if + +! 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 + +! 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 + +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 + linking = "" -do i = 1, size(files) - if (str_ends_with(files(i)%s, ".f90")) then - n = len(files(i)%s) - basename = files(i)%s(1:n-4) - call run("gfortran -c src/" // basename // ".f90 -o " // basename // ".o") - linking = linking // " " // basename // ".o" - end if +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 -call run("gfortran -c app/main.f90 -o main.o") -call package_name(pkg_name) -call run("gfortran main.o " // linking // " -o " // pkg_name) end subroutine subroutine cmd_install() diff --git a/fpm/src/fpm/config.f90 b/fpm/src/fpm/config.f90 new file mode 100644 index 0000000..03ad768 --- /dev/null +++ b/fpm/src/fpm/config.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_config + use fpm_config_executable, only : executable_t + use fpm_config_library, only : library_t + use fpm_config_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_config diff --git a/fpm/src/fpm/config/dependency.f90 b/fpm/src/fpm/config/dependency.f90 new file mode 100644 index 0000000..d98951f --- /dev/null +++ b/fpm/src/fpm/config/dependency.f90 @@ -0,0 +1,241 @@ +!> 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_config_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 (.not.allocated(list)) 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 .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 (.not.allocated(list)) 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_config_dependency diff --git a/fpm/src/fpm/config/executable.f90 b/fpm/src/fpm/config/executable.f90 new file mode 100644 index 0000000..f5078eb --- /dev/null +++ b/fpm/src/fpm/config/executable.f90 @@ -0,0 +1,173 @@ +!> 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_config_executable + use fpm_config_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) + 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 (.not.allocated(list)) 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_config_executable diff --git a/fpm/src/fpm/config/library.f90 b/fpm/src/fpm/config/library.f90 new file mode 100644 index 0000000..0650051 --- /dev/null +++ b/fpm/src/fpm/config/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_config_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 (.not.allocated(list)) 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_config_library diff --git a/fpm/src/fpm/config/package.f90 b/fpm/src/fpm/config/package.f90 new file mode 100644 index 0000000..66f275d --- /dev/null +++ b/fpm/src/fpm/config/package.f90 @@ -0,0 +1,270 @@ +!> 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_config_package + use fpm_config_dependency, only : dependency_t, new_dependencies + use fpm_config_executable, only : executable_t, new_executable + use fpm_config_library, only : library_t, new_library + use fpm_config_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) + + 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) + 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 + 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 + 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 + + character(len=:), allocatable :: name + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_key(name) + call table%get_keys(list) + + if (.not.allocated(list)) 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_config_package diff --git a/fpm/src/fpm/config/test.f90 b/fpm/src/fpm/config/test.f90 new file mode 100644 index 0000000..5c6c9f3 --- /dev/null +++ b/fpm/src/fpm/config/test.f90 @@ -0,0 +1,166 @@ +!> 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_config_test + use fpm_config_dependency, only : dependency_t, new_dependencies + use fpm_config_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) + 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 (.not.allocated(list)) 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 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, "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 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_config_test diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 new file mode 100644 index 0000000..957d3bf --- /dev/null +++ b/fpm/src/fpm/error.f90 @@ -0,0 +1,61 @@ +!> 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 + + character(len=:), allocatable :: message + + message = "'"//file_name//"' could not be found, check if the file exists" + + call move_alloc(message, error%message) + + 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/toml.f90 b/fpm/src/fpm/toml.f90 new file mode 100644 index 0000000..d847c69 --- /dev/null +++ b/fpm/src/fpm/toml.f90 @@ -0,0 +1,65 @@ +!> 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 : len + implicit none + private + + public :: read_package_file + public :: toml_table, toml_array, toml_key, toml_stat, get_value, len + + +contains + + + !> Process the configuration file to a TOML data structure + subroutine read_package_file(table, config, error) + + !> TOML data structure + type(toml_table), allocatable, intent(out) :: table + + !> Name of the package configuration file + character(len=*), intent(in) :: config + + !> Error status of the operation + type(error_t), allocatable, intent(out) :: error + + type(toml_error), allocatable :: parse_error + integer :: unit + logical :: exist + + inquire(file=config, exist=exist) + + if (.not.exist) then + call file_not_found_error(error, config) + return + end if + + open(file=config, 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 -- cgit v1.2.3 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 From fd77e6ba357390ec9a21506315b5578aaff513ce Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 3 Sep 2020 11:13:29 +0200 Subject: Rename config to manifest --- fpm/src/fpm.f90 | 2 +- fpm/src/fpm/config.f90 | 79 ----------- fpm/src/fpm/config/dependency.f90 | 241 -------------------------------- fpm/src/fpm/config/executable.f90 | 173 ----------------------- fpm/src/fpm/config/library.f90 | 126 ----------------- fpm/src/fpm/config/package.f90 | 270 ------------------------------------ fpm/src/fpm/config/test.f90 | 166 ---------------------- fpm/src/fpm/manifest.f90 | 79 +++++++++++ fpm/src/fpm/manifest/dependency.f90 | 241 ++++++++++++++++++++++++++++++++ fpm/src/fpm/manifest/executable.f90 | 173 +++++++++++++++++++++++ fpm/src/fpm/manifest/library.f90 | 126 +++++++++++++++++ fpm/src/fpm/manifest/package.f90 | 270 ++++++++++++++++++++++++++++++++++++ fpm/src/fpm/manifest/test.f90 | 166 ++++++++++++++++++++++ fpm/src/fpm/toml.f90 | 10 +- fpm/test/main.f90 | 6 +- fpm/test/test_config.f90 | 188 ------------------------- fpm/test/test_manifest.f90 | 188 +++++++++++++++++++++++++ fpm/test/test_toml.f90 | 16 +-- 18 files changed, 1260 insertions(+), 1260 deletions(-) delete mode 100644 fpm/src/fpm/config.f90 delete mode 100644 fpm/src/fpm/config/dependency.f90 delete mode 100644 fpm/src/fpm/config/executable.f90 delete mode 100644 fpm/src/fpm/config/library.f90 delete mode 100644 fpm/src/fpm/config/package.f90 delete mode 100644 fpm/src/fpm/config/test.f90 create mode 100644 fpm/src/fpm/manifest.f90 create mode 100644 fpm/src/fpm/manifest/dependency.f90 create mode 100644 fpm/src/fpm/manifest/executable.f90 create mode 100644 fpm/src/fpm/manifest/library.f90 create mode 100644 fpm/src/fpm/manifest/package.f90 create mode 100644 fpm/src/fpm/manifest/test.f90 delete mode 100644 fpm/test/test_config.f90 create mode 100644 fpm/test/test_manifest.f90 diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 5123436..9c8918b 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,6 +1,6 @@ module fpm use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_config, only : get_package_data, default_executable, default_library, & +use fpm_manifest, only : get_package_data, default_executable, default_library, & & package_t use fpm_error, only : error_t implicit none diff --git a/fpm/src/fpm/config.f90 b/fpm/src/fpm/config.f90 deleted file mode 100644 index 03ad768..0000000 --- a/fpm/src/fpm/config.f90 +++ /dev/null @@ -1,79 +0,0 @@ -!> 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_config - use fpm_config_executable, only : executable_t - use fpm_config_library, only : library_t - use fpm_config_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_config diff --git a/fpm/src/fpm/config/dependency.f90 b/fpm/src/fpm/config/dependency.f90 deleted file mode 100644 index d98951f..0000000 --- a/fpm/src/fpm/config/dependency.f90 +++ /dev/null @@ -1,241 +0,0 @@ -!> 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_config_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 (.not.allocated(list)) 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 .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 (.not.allocated(list)) 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_config_dependency diff --git a/fpm/src/fpm/config/executable.f90 b/fpm/src/fpm/config/executable.f90 deleted file mode 100644 index f5078eb..0000000 --- a/fpm/src/fpm/config/executable.f90 +++ /dev/null @@ -1,173 +0,0 @@ -!> 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_config_executable - use fpm_config_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) - 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 (.not.allocated(list)) 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_config_executable diff --git a/fpm/src/fpm/config/library.f90 b/fpm/src/fpm/config/library.f90 deleted file mode 100644 index 0650051..0000000 --- a/fpm/src/fpm/config/library.f90 +++ /dev/null @@ -1,126 +0,0 @@ -!> 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_config_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 (.not.allocated(list)) 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_config_library diff --git a/fpm/src/fpm/config/package.f90 b/fpm/src/fpm/config/package.f90 deleted file mode 100644 index 66f275d..0000000 --- a/fpm/src/fpm/config/package.f90 +++ /dev/null @@ -1,270 +0,0 @@ -!> 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_config_package - use fpm_config_dependency, only : dependency_t, new_dependencies - use fpm_config_executable, only : executable_t, new_executable - use fpm_config_library, only : library_t, new_library - use fpm_config_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) - - 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) - 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 - 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 - 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 - - character(len=:), allocatable :: name - type(toml_key), allocatable :: list(:) - logical :: name_present - integer :: ikey - - name_present = .false. - - call table%get_key(name) - call table%get_keys(list) - - if (.not.allocated(list)) 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_config_package diff --git a/fpm/src/fpm/config/test.f90 b/fpm/src/fpm/config/test.f90 deleted file mode 100644 index 5c6c9f3..0000000 --- a/fpm/src/fpm/config/test.f90 +++ /dev/null @@ -1,166 +0,0 @@ -!> 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_config_test - use fpm_config_dependency, only : dependency_t, new_dependencies - use fpm_config_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) - 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 (.not.allocated(list)) 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 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, "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 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_config_test 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..1ee61b7 --- /dev/null +++ b/fpm/src/fpm/manifest/dependency.f90 @@ -0,0 +1,241 @@ +!> 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 (.not.allocated(list)) 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 .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 (.not.allocated(list)) 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..704396a --- /dev/null +++ b/fpm/src/fpm/manifest/executable.f90 @@ -0,0 +1,173 @@ +!> 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) + 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 (.not.allocated(list)) 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..a297c2f --- /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 (.not.allocated(list)) 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..f318ad7 --- /dev/null +++ b/fpm/src/fpm/manifest/package.f90 @@ -0,0 +1,270 @@ +!> 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) + + 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) + 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 + 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 + 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 + + character(len=:), allocatable :: name + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_key(name) + call table%get_keys(list) + + if (.not.allocated(list)) 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..9b50315 --- /dev/null +++ b/fpm/src/fpm/manifest/test.f90 @@ -0,0 +1,166 @@ +!> 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) + 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 (.not.allocated(list)) 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 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, "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 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 index d847c69..d95a093 100644 --- a/fpm/src/fpm/toml.f90 +++ b/fpm/src/fpm/toml.f90 @@ -27,13 +27,13 @@ contains !> Process the configuration file to a TOML data structure - subroutine read_package_file(table, config, error) + 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) :: config + character(len=*), intent(in) :: manifest !> Error status of the operation type(error_t), allocatable, intent(out) :: error @@ -42,14 +42,14 @@ contains integer :: unit logical :: exist - inquire(file=config, exist=exist) + inquire(file=manifest, exist=exist) if (.not.exist) then - call file_not_found_error(error, config) + call file_not_found_error(error, manifest) return end if - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) call toml_parse(table, unit, parse_error) close(unit) diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 index c4bfee5..19bcdb6 100644 --- a/fpm/test/main.f90 +++ b/fpm/test/main.f90 @@ -3,7 +3,7 @@ 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 + use test_manifest, only : collect_manifest implicit none integer :: stat character(len=*), parameter :: fmt = '("#", *(1x, a))' @@ -16,8 +16,8 @@ program fpm_testing error stop 1 end if - write(error_unit, fmt) "Testing:", "fpm_config" - call run_testsuite(collect_config, error_unit, stat) + 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!" diff --git a/fpm/test/test_config.f90 b/fpm/test/test_config.f90 deleted file mode 100644 index ecdf0a5..0000000 --- a/fpm/test/test_config.f90 +++ /dev/null @@ -1,188 +0,0 @@ -!> 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_manifest.f90 b/fpm/test/test_manifest.f90 new file mode 100644 index 0000000..08236d5 --- /dev/null +++ b/fpm/test/test_manifest.f90 @@ -0,0 +1,188 @@ +!> 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)] + + 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' + character(len=:), allocatable :: string + 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' + character(len=:), allocatable :: string + 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 + + +end module test_manifest diff --git a/fpm/test/test_toml.f90 b/fpm/test/test_toml.f90 index 8d57150..d30ef0d 100644 --- a/fpm/test/test_toml.f90 +++ b/fpm/test/test_toml.f90 @@ -31,11 +31,11 @@ contains type(error_t), allocatable, intent(out) :: error type(toml_table), allocatable :: table - character(len=*), parameter :: config = 'fpm-valid-toml.toml' + character(len=*), parameter :: manifest = 'fpm-valid-toml.toml' character(len=:), allocatable :: string integer :: unit - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) write(unit, '(a)') & & 'name = "example"', & & '[dependencies.fpm]', & @@ -55,9 +55,9 @@ contains & 'lib""" # comment' close(unit) - call read_package_file(table, config, error) + call read_package_file(table, manifest, error) - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) close(unit, status='delete') end subroutine test_valid_toml @@ -70,11 +70,11 @@ contains type(error_t), allocatable, intent(out) :: error type(toml_table), allocatable :: table - character(len=*), parameter :: config = 'fpm-invalid-toml.toml' + character(len=*), parameter :: manifest = 'fpm-invalid-toml.toml' character(len=:), allocatable :: string integer :: unit - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) write(unit, '(a)') & & '# INVALID TOML DOC', & & 'name = "example"', & @@ -84,9 +84,9 @@ contains & '"toml..f" = { path = ".." }' close(unit) - call read_package_file(table, config, error) + call read_package_file(table, manifest, error) - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) close(unit, status='delete') end subroutine test_invalid_toml -- cgit v1.2.3 From 5b833ce91986e6aa9c6d1ba3908a1b593c035fad Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Fri, 4 Sep 2020 20:52:50 +0200 Subject: Catch some previously unbound errors --- fpm/src/fpm/manifest/executable.f90 | 4 ++++ fpm/src/fpm/manifest/package.f90 | 9 +++++++-- fpm/src/fpm/manifest/test.f90 | 4 ++++ 3 files changed, 15 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 index 704396a..94d4000 100644 --- a/fpm/src/fpm/manifest/executable.f90 +++ b/fpm/src/fpm/manifest/executable.f90 @@ -63,6 +63,10 @@ contains 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") diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index f318ad7..95194d2 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -93,6 +93,10 @@ contains 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 @@ -110,6 +114,7 @@ contains 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.) @@ -125,6 +130,7 @@ contains 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.) @@ -140,6 +146,7 @@ contains call new_test(self%test(ii), node, error) if (allocated(error)) exit end do + if (allocated(error)) return end if end subroutine new_package @@ -154,14 +161,12 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: name type(toml_key), allocatable :: list(:) logical :: name_present integer :: ikey name_present = .false. - call table%get_key(name) call table%get_keys(list) if (.not.allocated(list)) then diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 index 9b50315..c35ea63 100644 --- a/fpm/src/fpm/manifest/test.f90 +++ b/fpm/src/fpm/manifest/test.f90 @@ -56,6 +56,10 @@ contains 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") -- cgit v1.2.3 From 10b9ca3746292a1e2f1e40c3af86dd8d04d1bcea Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Fri, 4 Sep 2020 21:44:14 +0200 Subject: Increase testing coverage - fix unallocated access to error_t in file_not_found generator - account for fact that key-list will be allocated with size 0 for empty key-tables - test response of constructor on empty TOML tables --- fpm/src/fpm/error.f90 | 7 +- fpm/src/fpm/manifest/dependency.f90 | 9 ++- fpm/src/fpm/manifest/executable.f90 | 2 +- fpm/src/fpm/manifest/library.f90 | 2 +- fpm/src/fpm/manifest/package.f90 | 2 +- fpm/src/fpm/manifest/test.f90 | 6 +- fpm/src/fpm/toml.f90 | 5 +- fpm/test/test_manifest.f90 | 136 +++++++++++++++++++++++++++++++++++- fpm/test/test_toml.f90 | 18 ++++- 9 files changed, 170 insertions(+), 17 deletions(-) diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 index 957d3bf..aebd7e4 100644 --- a/fpm/src/fpm/error.f90 +++ b/fpm/src/fpm/error.f90 @@ -49,11 +49,8 @@ contains !> Name of the missing file character(len=*), intent(in) :: file_name - character(len=:), allocatable :: message - - message = "'"//file_name//"' could not be found, check if the file exists" - - call move_alloc(message, error%message) + allocate(error) + error%message = "'"//file_name//"' could not be found, check if the file exists" end subroutine file_not_found_error diff --git a/fpm/src/fpm/manifest/dependency.f90 b/fpm/src/fpm/manifest/dependency.f90 index 1ee61b7..8a3d879 100644 --- a/fpm/src/fpm/manifest/dependency.f90 +++ b/fpm/src/fpm/manifest/dependency.f90 @@ -129,7 +129,7 @@ contains call table%get_key(name) call table%get_keys(list) - if (.not.allocated(list)) then + if (size(list) < 1) then call syntax_error(error, "Dependency "//name//" does not provide sufficient entries") return end if @@ -158,6 +158,11 @@ contains 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 @@ -183,7 +188,7 @@ contains call table%get_keys(list) ! An empty table is okay - if (.not.allocated(list)) return + if (size(list) < 1) return allocate(deps(size(list))) do idep = 1, size(list) diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 index 94d4000..f706001 100644 --- a/fpm/src/fpm/manifest/executable.f90 +++ b/fpm/src/fpm/manifest/executable.f90 @@ -96,7 +96,7 @@ contains call table%get_keys(list) - if (.not.allocated(list)) then + if (size(list) < 1) then call syntax_error(error, "Executable section does not provide sufficient entries") return end if diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90 index a297c2f..40e5e92 100644 --- a/fpm/src/fpm/manifest/library.f90 +++ b/fpm/src/fpm/manifest/library.f90 @@ -72,7 +72,7 @@ contains call table%get_keys(list) ! table can be empty - if (.not.allocated(list)) return + if (size(list) < 1) return do ikey = 1, size(list) select case(list(ikey)%key) diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index 95194d2..4c2c14a 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -169,7 +169,7 @@ contains call table%get_keys(list) - if (.not.allocated(list)) then + if (size(list) < 1) then call syntax_error(error, "Package file is empty") return end if diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 index c35ea63..a6c6f64 100644 --- a/fpm/src/fpm/manifest/test.f90 +++ b/fpm/src/fpm/manifest/test.f90 @@ -89,8 +89,8 @@ contains call table%get_keys(list) - if (.not.allocated(list)) then - call syntax_error(error, "Executable section does not provide sufficient entries") + if (size(list) < 1) then + call syntax_error(error, "Test section does not provide sufficient entries") return end if @@ -110,7 +110,7 @@ contains end do if (.not.name_present) then - call syntax_error(error, "Executable name is not provided, please add a name entry") + call syntax_error(error, "Test name is not provided, please add a name entry") end if end subroutine check diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90 index d95a093..183278d 100644 --- a/fpm/src/fpm/toml.f90 +++ b/fpm/src/fpm/toml.f90 @@ -15,12 +15,13 @@ 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 : len + 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, len + public :: toml_table, toml_array, toml_key, toml_stat, get_value + public :: new_table, len contains diff --git a/fpm/test/test_manifest.f90 b/fpm/test/test_manifest.f90 index 08236d5..117ea3a 100644 --- a/fpm/test/test_manifest.f90 +++ b/fpm/test/test_manifest.f90 @@ -21,7 +21,13 @@ contains & 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("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 @@ -185,4 +191,132 @@ contains 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 index d30ef0d..0a5abd6 100644 --- a/fpm/test/test_toml.f90 +++ b/fpm/test/test_toml.f90 @@ -19,7 +19,8 @@ contains testsuite = [ & & new_unittest("valid-toml", test_valid_toml), & - & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.)] + & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & + & new_unittest("missing-file", test_missing_file, should_fail=.true.)] end subroutine collect_toml @@ -92,4 +93,19 @@ contains 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 + character(len=:), allocatable :: string + integer :: unit + + call read_package_file(table, 'low+chance+of+existing.toml', error) + + end subroutine test_missing_file + + end module test_toml -- cgit v1.2.3 From 89813e843ccde573bad9c7231ecbd7623c5f1a7b Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Sat, 5 Sep 2020 09:14:31 +0200 Subject: Pin commit of toml-f --- fpm/fpm.toml | 4 +++- fpm/test/test_manifest.f90 | 2 -- fpm/test/test_toml.f90 | 4 ---- 3 files changed, 3 insertions(+), 7 deletions(-) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 9a0009f..b39d881 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -6,7 +6,9 @@ maintainer = "" copyright = "2020 fpm contributors" [dependencies] -toml-f = { git = "https://github.com/toml-f/toml-f" } +[dependencies.toml-f] +git = "https://github.com/toml-f/toml-f" +rev = "290ba87671ab593e7bd51599e1d80ea736b3cd36" [[test]] name = "fpm-test" diff --git a/fpm/test/test_manifest.f90 b/fpm/test/test_manifest.f90 index 117ea3a..7ad5e5a 100644 --- a/fpm/test/test_manifest.f90 +++ b/fpm/test/test_manifest.f90 @@ -40,7 +40,6 @@ contains type(package_t) :: package character(len=*), parameter :: manifest = 'fpm-valid-manifest.toml' - character(len=:), allocatable :: string integer :: unit open(file=manifest, newunit=unit) @@ -116,7 +115,6 @@ contains type(package_t) :: package character(len=*), parameter :: manifest = 'fpm-invalid-manifest.toml' - character(len=:), allocatable :: string integer :: unit open(file=manifest, newunit=unit) diff --git a/fpm/test/test_toml.f90 b/fpm/test/test_toml.f90 index 0a5abd6..ba48307 100644 --- a/fpm/test/test_toml.f90 +++ b/fpm/test/test_toml.f90 @@ -33,7 +33,6 @@ contains type(toml_table), allocatable :: table character(len=*), parameter :: manifest = 'fpm-valid-toml.toml' - character(len=:), allocatable :: string integer :: unit open(file=manifest, newunit=unit) @@ -72,7 +71,6 @@ contains type(toml_table), allocatable :: table character(len=*), parameter :: manifest = 'fpm-invalid-toml.toml' - character(len=:), allocatable :: string integer :: unit open(file=manifest, newunit=unit) @@ -100,8 +98,6 @@ contains type(error_t), allocatable, intent(out) :: error type(toml_table), allocatable :: table - character(len=:), allocatable :: string - integer :: unit call read_package_file(table, 'low+chance+of+existing.toml', error) -- cgit v1.2.3