diff options
| -rw-r--r-- | fpm/fpm.toml | 3 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 70 | ||||
| -rw-r--r-- | fpm/src/fpm/config.f90 | 79 | ||||
| -rw-r--r-- | fpm/src/fpm/config/dependency.f90 | 241 | ||||
| -rw-r--r-- | fpm/src/fpm/config/executable.f90 | 173 | ||||
| -rw-r--r-- | fpm/src/fpm/config/library.f90 | 126 | ||||
| -rw-r--r-- | fpm/src/fpm/config/package.f90 | 270 | ||||
| -rw-r--r-- | fpm/src/fpm/config/test.f90 | 166 | ||||
| -rw-r--r-- | fpm/src/fpm/error.f90 | 61 | ||||
| -rw-r--r-- | fpm/src/fpm/git.f90 | 170 | ||||
| -rw-r--r-- | fpm/src/fpm/toml.f90 | 65 |
11 files changed, 1401 insertions, 23 deletions
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 |