aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLaurence Kedward <laurence.kedward@bristol.ac.uk>2020-11-25 09:29:10 +0000
committerGitHub <noreply@github.com>2020-11-25 09:29:10 +0000
commitc4ce73e485cf48d6b6b3e9f34938c7f8effec22b (patch)
tree9c28c201960f3a99534d10a5bd096ca0a0d9eb71
parentc68cf2fbdb40c33636bd50b6a729490ae9d61654 (diff)
parentd9d152481a84445fb6596ac2f1e8696ad964ec9d (diff)
downloadfpm-c4ce73e485cf48d6b6b3e9f34938c7f8effec22b.tar.gz
fpm-c4ce73e485cf48d6b6b3e9f34938c7f8effec22b.zip
Merge pull request #247 from awvwgk/manifest
Refactoring of manifest types
-rw-r--r--fpm/src/fpm.f9074
-rw-r--r--fpm/src/fpm/manifest.f9070
-rw-r--r--fpm/src/fpm/manifest/build.f90 (renamed from fpm/src/fpm/manifest/build_config.f90)4
-rw-r--r--fpm/src/fpm/manifest/dependency.f9012
-rw-r--r--fpm/src/fpm/manifest/executable.f9014
-rw-r--r--fpm/src/fpm/manifest/library.f9010
-rw-r--r--fpm/src/fpm/manifest/package.f9036
-rw-r--r--fpm/src/fpm/manifest/test.f9014
-rw-r--r--fpm/src/fpm_sources.f906
-rw-r--r--fpm/test/fpm_test/test_manifest.f9096
10 files changed, 174 insertions, 162 deletions
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90
index daa4d98..8bf7a98 100644
--- a/fpm/src/fpm.f90
+++ b/fpm/src/fpm.f90
@@ -12,14 +12,13 @@ use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, &
use fpm_sources, only: add_executable_sources, add_sources_from_dir
use fpm_targets, only: targets_from_sources, resolve_module_dependencies
-use fpm_manifest, only : get_package_data, default_executable, &
- default_library, package_t, default_test
+use fpm_manifest, only : get_package_data, package_config_t
use fpm_error, only : error_t, fatal_error
-use fpm_manifest_test, only : test_t
+use fpm_manifest_test, only : test_config_t
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
& stdout=>output_unit, &
& stderr=>error_unit
-use fpm_manifest_dependency, only: dependency_t
+use fpm_manifest_dependency, only: dependency_config_t
implicit none
private
public :: cmd_build, cmd_install, cmd_run
@@ -34,7 +33,7 @@ recursive subroutine add_libsources_from_package(sources,link_libraries,package_
type(srcfile_t), allocatable, intent(inout), target :: sources(:)
type(string_t), allocatable, intent(inout) :: link_libraries(:)
type(string_t), allocatable, intent(inout) :: package_list(:)
- type(package_t), intent(in) :: package
+ type(package_config_t), intent(in) :: package
character(*), intent(in) :: package_root
logical, intent(in) :: dev_depends
type(error_t), allocatable, intent(out) :: error
@@ -76,11 +75,11 @@ recursive subroutine add_libsources_from_package(sources,link_libraries,package_
contains
subroutine add_dependencies(dependency_list)
- type(dependency_t), intent(in) :: dependency_list(:)
+ type(dependency_config_t), intent(in) :: dependency_list(:)
integer :: i
type(string_t) :: dep_name
- type(package_t) :: dependency
+ type(package_config_t) :: dependency
character(:), allocatable :: dependency_path
@@ -135,8 +134,8 @@ recursive subroutine add_libsources_from_package(sources,link_libraries,package_
dep_name%s = dependency_list(i)%name
package_list = [package_list, dep_name]
- if (allocated(dependency%build_config%link)) then
- link_libraries = [link_libraries, dependency%build_config%link]
+ if (allocated(dependency%build%link)) then
+ link_libraries = [link_libraries, dependency%build%link]
end if
end do
@@ -151,15 +150,15 @@ subroutine build_model(model, settings, package, error)
!
type(fpm_model_t), intent(out) :: model
type(fpm_build_settings), intent(in) :: settings
- type(package_t), intent(in) :: package
+ type(package_config_t), intent(in) :: package
type(error_t), allocatable, intent(out) :: error
integer :: i
type(string_t), allocatable :: package_list(:)
model%package_name = package%name
- if (allocated(package%build_config%link)) then
- model%link_libraries = package%build_config%link
+ if (allocated(package%build%link)) then
+ model%link_libraries = package%build%link
else
allocate(model%link_libraries(0))
end if
@@ -189,7 +188,7 @@ subroutine build_model(model, settings, package, error)
model%link_flags = ''
! Add sources from executable directories
- if (is_dir('app') .and. package%build_config%auto_executables) then
+ if (is_dir('app') .and. package%build%auto_executables) then
call add_sources_from_dir(model%sources,'app', FPM_SCOPE_APP, &
with_executables=.true., error=error)
@@ -198,7 +197,7 @@ subroutine build_model(model, settings, package, error)
end if
end if
- if (is_dir('test') .and. package%build_config%auto_tests) then
+ if (is_dir('test') .and. package%build%auto_tests) then
call add_sources_from_dir(model%sources,'test', FPM_SCOPE_TEST, &
with_executables=.true., error=error)
@@ -209,7 +208,7 @@ subroutine build_model(model, settings, package, error)
end if
if (allocated(package%executable)) then
call add_executable_sources(model%sources, package%executable, FPM_SCOPE_APP, &
- auto_discover=package%build_config%auto_executables, &
+ auto_discover=package%build%auto_executables, &
error=error)
if (allocated(error)) then
@@ -219,7 +218,7 @@ subroutine build_model(model, settings, package, error)
end if
if (allocated(package%test)) then
call add_executable_sources(model%sources, package%test, FPM_SCOPE_TEST, &
- auto_discover=package%build_config%auto_tests, &
+ auto_discover=package%build%auto_tests, &
error=error)
if (allocated(error)) then
@@ -245,53 +244,21 @@ subroutine build_model(model, settings, package, error)
end subroutine build_model
-!> Apply package defaults
-subroutine package_defaults(package)
- type(package_t), intent(inout) :: package
-
- ! Populate library in case we find the default src directory
- if (.not.allocated(package%library) .and. exists("src")) then
- allocate(package%library)
- call default_library(package%library)
- end if
-
- ! Populate executable in case we find the default app
- if (.not.allocated(package%executable) .and. &
- exists(join_path('app',"main.f90"))) then
- allocate(package%executable(1))
- call default_executable(package%executable(1), package%name)
- end if
-
- ! Populate test in case we find the default test directory
- if (.not.allocated(package%test) .and. &
- exists(join_path("test","main.f90"))) then
- allocate(package%test(1))
- call default_test(package%test(1), package%name)
- endif
-
- 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
-
-end subroutine
subroutine cmd_build(settings)
type(fpm_build_settings), intent(in) :: settings
-type(package_t) :: package
+type(package_config_t) :: package
type(fpm_model_t) :: model
type(error_t), allocatable :: error
integer :: i
-call get_package_data(package, "fpm.toml", error)
+call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
if (allocated(error)) then
print '(a)', error%message
error stop 1
end if
-call package_defaults(package)
-
call build_model(model, settings, package, error)
if (allocated(error)) then
print '(a)', error%message
@@ -322,22 +289,19 @@ subroutine cmd_run(settings,test)
integer :: i, j, col_width, nCol
logical :: found(size(settings%name))
type(error_t), allocatable :: error
- type(package_t) :: package
+ type(package_config_t) :: package
type(fpm_model_t) :: model
type(string_t) :: exe_cmd
type(string_t), allocatable :: executables(:)
type(build_target_t), pointer :: exe_target
type(srcfile_t), pointer :: exe_source
- call get_package_data(package, "fpm.toml", error)
+ call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
if (allocated(error)) then
print '(a)', error%message
error stop 1
end if
-
- call package_defaults(package)
-
call build_model(model, settings%fpm_build_settings, package, error)
if (allocated(error)) then
print '(a)', error%message
diff --git a/fpm/src/fpm/manifest.f90 b/fpm/src/fpm/manifest.f90
index 9d2e793..362ac69 100644
--- a/fpm/src/fpm/manifest.f90
+++ b/fpm/src/fpm/manifest.f90
@@ -7,18 +7,19 @@
!> Additionally, the required data types for users of this module are reexported
!> to hide the actual implementation details.
module fpm_manifest
- use fpm_manifest_build_config, only: build_config_t
- 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_manifest_build, only: build_config_t
+ use fpm_manifest_executable, only : executable_config_t
+ use fpm_manifest_library, only : library_config_t
+ use fpm_manifest_package, only : package_config_t, new_package
use fpm_error, only : error_t, fatal_error, file_not_found_error
use fpm_toml, only : toml_table, read_package_file
- use fpm_manifest_test, only : test_t
+ use fpm_manifest_test, only : test_config_t
+ use fpm_filesystem, only: join_path, exists
implicit none
private
public :: get_package_data, default_executable, default_library, default_test
- public :: package_t
+ public :: package_config_t
contains
@@ -28,7 +29,7 @@ contains
subroutine default_library(self)
!> Instance of the library meta data
- type(library_t), intent(out) :: self
+ type(library_config_t), intent(out) :: self
self%source_dir = "src"
@@ -39,7 +40,7 @@ contains
subroutine default_executable(self, name)
!> Instance of the executable meta data
- type(executable_t), intent(out) :: self
+ type(executable_config_t), intent(out) :: self
!> Name of the package
character(len=*), intent(in) :: name
@@ -54,7 +55,7 @@ contains
subroutine default_test(self, name)
!> Instance of the executable meta data
- type(test_t), intent(out) :: self
+ type(test_config_t), intent(out) :: self
!> Name of the package
character(len=*), intent(in) :: name
@@ -67,10 +68,10 @@ contains
!> Obtain package meta data from a configuation file
- subroutine get_package_data(package, file, error)
+ subroutine get_package_data(package, file, error, apply_defaults)
!> Parsed package meta data
- type(package_t), intent(out) :: package
+ type(package_config_t), intent(out) :: package
!> Name of the package configuration file
character(len=*), intent(in) :: file
@@ -78,6 +79,9 @@ contains
!> Error status of the operation
type(error_t), allocatable, intent(out) :: error
+ !> Apply package defaults (uses file system operations)
+ logical, intent(in), optional :: apply_defaults
+
type(toml_table), allocatable :: table
call read_package_file(table, file, error)
@@ -90,7 +94,51 @@ contains
call new_package(package, table, error)
+ if (present(apply_defaults)) then
+ if (apply_defaults) then
+ call package_defaults(package, error)
+ if (allocated(error)) return
+ end if
+ end if
+
end subroutine get_package_data
+ !> Apply package defaults
+ subroutine package_defaults(package, error)
+
+ !> Parsed package meta data
+ type(package_config_t), intent(inout) :: package
+
+ !> Error status of the operation
+ type(error_t), allocatable, intent(out) :: error
+
+ ! Populate library in case we find the default src directory
+ if (.not.allocated(package%library) .and. exists("src")) then
+ allocate(package%library)
+ call default_library(package%library)
+ end if
+
+ ! Populate executable in case we find the default app
+ if (.not.allocated(package%executable) .and. &
+ exists(join_path('app',"main.f90"))) then
+ allocate(package%executable(1))
+ call default_executable(package%executable(1), package%name)
+ end if
+
+ ! Populate test in case we find the default test directory
+ if (.not.allocated(package%test) .and. &
+ exists(join_path("test","main.f90"))) then
+ allocate(package%test(1))
+ call default_test(package%test(1), package%name)
+ endif
+
+ if (.not.(allocated(package%library) .or. allocated(package%executable))) then
+ call fatal_error(error, "Neither library nor executable found, there is nothing to do")
+ return
+ end if
+
+ end subroutine package_defaults
+
+
end module fpm_manifest
diff --git a/fpm/src/fpm/manifest/build_config.f90 b/fpm/src/fpm/manifest/build.f90
index 612c051..85fd2c7 100644
--- a/fpm/src/fpm/manifest/build_config.f90
+++ b/fpm/src/fpm/manifest/build.f90
@@ -8,7 +8,7 @@
!>auto-tests = bool
!>link = ["lib"]
!>```
-module fpm_manifest_build_config
+module fpm_manifest_build
use fpm_error, only : error_t, syntax_error, fatal_error
use fpm_strings, only : string_t
use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
@@ -146,4 +146,4 @@ contains
end subroutine info
-end module fpm_manifest_build_config
+end module fpm_manifest_build
diff --git a/fpm/src/fpm/manifest/dependency.f90 b/fpm/src/fpm/manifest/dependency.f90
index a35beb6..26b76ee 100644
--- a/fpm/src/fpm/manifest/dependency.f90
+++ b/fpm/src/fpm/manifest/dependency.f90
@@ -30,11 +30,11 @@ module fpm_manifest_dependency
implicit none
private
- public :: dependency_t, new_dependency, new_dependencies
+ public :: dependency_config_t, new_dependency, new_dependencies
!> Configuration meta data for a dependency
- type :: dependency_t
+ type :: dependency_config_t
!> Name of the dependency
character(len=:), allocatable :: name
@@ -50,7 +50,7 @@ module fpm_manifest_dependency
!> Print information on this instance
procedure :: info
- end type dependency_t
+ end type dependency_config_t
contains
@@ -60,7 +60,7 @@ contains
subroutine new_dependency(self, table, error)
!> Instance of the dependency configuration
- type(dependency_t), intent(out) :: self
+ type(dependency_config_t), intent(out) :: self
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
@@ -176,7 +176,7 @@ contains
subroutine new_dependencies(deps, table, error)
!> Instance of the dependency configuration
- type(dependency_t), allocatable, intent(out) :: deps(:)
+ type(dependency_config_t), allocatable, intent(out) :: deps(:)
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
@@ -210,7 +210,7 @@ contains
subroutine info(self, unit, verbosity)
!> Instance of the dependency configuration
- class(dependency_t), intent(in) :: self
+ class(dependency_config_t), intent(in) :: self
!> Unit for IO
integer, intent(in) :: unit
diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90
index b34c409..be02974 100644
--- a/fpm/src/fpm/manifest/executable.f90
+++ b/fpm/src/fpm/manifest/executable.f90
@@ -11,18 +11,18 @@
!>[executable.dependencies]
!>```
module fpm_manifest_executable
- use fpm_manifest_dependency, only : dependency_t, new_dependencies
+ use fpm_manifest_dependency, only : dependency_config_t, new_dependencies
use fpm_error, only : error_t, syntax_error
use fpm_strings, only : string_t
use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
implicit none
private
- public :: executable_t, new_executable
+ public :: executable_config_t, new_executable
!> Configuation meta data for an executable
- type :: executable_t
+ type :: executable_config_t
!> Name of the resulting executable
character(len=:), allocatable :: name
@@ -34,7 +34,7 @@ module fpm_manifest_executable
character(len=:), allocatable :: main
!> Dependency meta data for this executable
- type(dependency_t), allocatable :: dependency(:)
+ type(dependency_config_t), allocatable :: dependency(:)
!> Libraries to link against
type(string_t), allocatable :: link(:)
@@ -44,7 +44,7 @@ module fpm_manifest_executable
!> Print information on this instance
procedure :: info
- end type executable_t
+ end type executable_config_t
contains
@@ -54,7 +54,7 @@ contains
subroutine new_executable(self, table, error)
!> Instance of the executable configuration
- type(executable_t), intent(out) :: self
+ type(executable_config_t), intent(out) :: self
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
@@ -136,7 +136,7 @@ contains
subroutine info(self, unit, verbosity)
!> Instance of the executable configuration
- class(executable_t), intent(in) :: self
+ class(executable_config_t), intent(in) :: self
!> Unit for IO
integer, intent(in) :: unit
diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90
index 965e0f8..6c4630d 100644
--- a/fpm/src/fpm/manifest/library.f90
+++ b/fpm/src/fpm/manifest/library.f90
@@ -13,11 +13,11 @@ module fpm_manifest_library
implicit none
private
- public :: library_t, new_library
+ public :: library_config_t, new_library
!> Configuration meta data for a library
- type :: library_t
+ type :: library_config_t
!> Source path prefix
character(len=:), allocatable :: source_dir
@@ -30,7 +30,7 @@ module fpm_manifest_library
!> Print information on this instance
procedure :: info
- end type library_t
+ end type library_config_t
contains
@@ -40,7 +40,7 @@ contains
subroutine new_library(self, table, error)
!> Instance of the library configuration
- type(library_t), intent(out) :: self
+ type(library_config_t), intent(out) :: self
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
@@ -93,7 +93,7 @@ contains
subroutine info(self, unit, verbosity)
!> Instance of the library configuration
- class(library_t), intent(in) :: self
+ class(library_config_t), intent(in) :: self
!> Unit for IO
integer, intent(in) :: unit
diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90
index b55e6d6..64b0f82 100644
--- a/fpm/src/fpm/manifest/package.f90
+++ b/fpm/src/fpm/manifest/package.f90
@@ -28,11 +28,11 @@
!>[[ test ]]
!>```
module fpm_manifest_package
- use fpm_manifest_build_config, only: build_config_t, new_build_config
- 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_manifest_build, only: build_config_t, new_build_config
+ use fpm_manifest_dependency, only : dependency_config_t, new_dependencies
+ use fpm_manifest_executable, only : executable_config_t, new_executable
+ use fpm_manifest_library, only : library_config_t, new_library
+ use fpm_manifest_test, only : test_config_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
@@ -40,42 +40,42 @@ module fpm_manifest_package
implicit none
private
- public :: package_t, new_package
+ public :: package_config_t, new_package
!> Package meta data
- type :: package_t
+ type :: package_config_t
!> Name of the package
character(len=:), allocatable :: name
!> Build configuration data
- type(build_config_t) :: build_config
+ type(build_config_t) :: build
!> Package version
type(version_t) :: version
!> Library meta data
- type(library_t), allocatable :: library
+ type(library_config_t), allocatable :: library
!> Executable meta data
- type(executable_t), allocatable :: executable(:)
+ type(executable_config_t), allocatable :: executable(:)
!> Dependency meta data
- type(dependency_t), allocatable :: dependency(:)
+ type(dependency_config_t), allocatable :: dependency(:)
!> Development dependency meta data
- type(dependency_t), allocatable :: dev_dependency(:)
+ type(dependency_config_t), allocatable :: dev_dependency(:)
!> Test meta data
- type(test_t), allocatable :: test(:)
+ type(test_config_t), allocatable :: test(:)
contains
!> Print information on this instance
procedure :: info
- end type package_t
+ end type package_config_t
contains
@@ -85,7 +85,7 @@ contains
subroutine new_package(self, table, error)
!> Instance of the package configuration
- type(package_t), intent(out) :: self
+ type(package_config_t), intent(out) :: self
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
@@ -112,7 +112,7 @@ contains
call fatal_error(error, "Type mismatch for build entry, must be a table")
return
end if
- call new_build_config(self%build_config, child, error)
+ call new_build_config(self%build, child, error)
if (allocated(error)) return
@@ -227,7 +227,7 @@ contains
subroutine info(self, unit, verbosity)
!> Instance of the package configuration
- class(package_t), intent(in) :: self
+ class(package_config_t), intent(in) :: self
!> Unit for IO
integer, intent(in) :: unit
@@ -252,7 +252,7 @@ contains
write(unit, fmt) "- name", self%name
end if
- call self%build_config%info(unit, pr - 1)
+ call self%build%info(unit, pr - 1)
if (allocated(self%library)) then
write(unit, fmt) "- target", "archive"
diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90
index cb7f666..bcacbd8 100644
--- a/fpm/src/fpm/manifest/test.f90
+++ b/fpm/src/fpm/manifest/test.f90
@@ -15,25 +15,25 @@
!>[test.dependencies]
!>```
module fpm_manifest_test
- use fpm_manifest_dependency, only : dependency_t, new_dependencies
- use fpm_manifest_executable, only : executable_t
+ use fpm_manifest_dependency, only : dependency_config_t, new_dependencies
+ use fpm_manifest_executable, only : executable_config_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
+ public :: test_config_t, new_test
!> Configuation meta data for an test
- type, extends(executable_t) :: test_t
+ type, extends(executable_config_t) :: test_config_t
contains
!> Print information on this instance
procedure :: info
- end type test_t
+ end type test_config_t
contains
@@ -43,7 +43,7 @@ contains
subroutine new_test(self, table, error)
!> Instance of the test configuration
- type(test_t), intent(out) :: self
+ type(test_config_t), intent(out) :: self
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
@@ -125,7 +125,7 @@ contains
subroutine info(self, unit, verbosity)
!> Instance of the test configuration
- class(test_t), intent(in) :: self
+ class(test_config_t), intent(in) :: self
!> Unit for IO
integer, intent(in) :: unit
diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90
index fa5c6e7..5e42430 100644
--- a/fpm/src/fpm_sources.f90
+++ b/fpm/src/fpm_sources.f90
@@ -8,7 +8,7 @@ use fpm_model, only: srcfile_t, fpm_model_t, &
use fpm_filesystem, only: basename, canon_path, dirname, join_path, read_lines, list_files
use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.)
-use fpm_manifest_executable, only: executable_t
+use fpm_manifest_executable, only: executable_config_t
implicit none
private
@@ -123,7 +123,7 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error)
! in [[executable]] entries and apply any customisations
!
type(srcfile_t), allocatable, intent(inout), target :: sources(:)
- class(executable_t), intent(in) :: executables(:)
+ class(executable_config_t), intent(in) :: executables(:)
integer, intent(in) :: scope
logical, intent(in) :: auto_discover
type(error_t), allocatable, intent(out) :: error
@@ -189,7 +189,7 @@ subroutine get_executable_source_dirs(exe_dirs,executables)
! Build a list of unique source directories
! from executables specified in manifest
type(string_t), allocatable, intent(inout) :: exe_dirs(:)
- class(executable_t), intent(in) :: executables(:)
+ class(executable_config_t), intent(in) :: executables(:)
type(string_t) :: dirs_temp(size(executables))
diff --git a/fpm/test/fpm_test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90
index 1116a74..a81504d 100644
--- a/fpm/test/fpm_test/test_manifest.f90
+++ b/fpm/test/fpm_test/test_manifest.f90
@@ -36,9 +36,9 @@ contains
& new_unittest("executable-typeerror", test_executable_typeerror, should_fail=.true.), &
& new_unittest("executable-noname", test_executable_noname, should_fail=.true.), &
& new_unittest("executable-wrongkey", test_executable_wrongkey, should_fail=.true.), &
- & new_unittest("build-config-valid", test_build_config_valid), &
- & new_unittest("build-config-empty", test_build_config_empty), &
- & new_unittest("build-config-invalid-values", test_build_config_invalid_values, should_fail=.true.), &
+ & new_unittest("build-config-valid", test_build_valid), &
+ & new_unittest("build-config-empty", test_build_empty), &
+ & new_unittest("build-config-invalid-values", test_build_invalid_values, should_fail=.true.), &
& new_unittest("library-empty", test_library_empty), &
& new_unittest("library-wrongkey", test_library_wrongkey, should_fail=.true.), &
& new_unittest("package-simple", test_package_simple), &
@@ -65,7 +65,7 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- type(package_t) :: package
+ type(package_config_t) :: package
character(len=*), parameter :: manifest = 'fpm-valid-manifest.toml'
integer :: unit
@@ -143,7 +143,7 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- type(package_t) :: package
+ type(package_config_t) :: package
character(len=*), parameter :: manifest = 'fpm-invalid-manifest.toml'
integer :: unit
@@ -168,7 +168,7 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- type(package_t) :: package
+ type(package_config_t) :: package
allocate(package%library)
call default_library(package%library)
@@ -186,7 +186,7 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- type(package_t) :: package
+ type(package_config_t) :: package
character(len=*), parameter :: name = "default"
allocate(package%executable(1))
@@ -212,7 +212,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(toml_table) :: table
- type(dependency_t) :: dependency
+ type(dependency_config_t) :: dependency
call new_table(table)
table%key = "example"
@@ -232,7 +232,7 @@ contains
type(toml_table) :: table
integer :: stat
- type(dependency_t) :: dependency
+ type(dependency_config_t) :: dependency
call new_table(table)
table%key = 'example'
@@ -254,7 +254,7 @@ contains
type(toml_table) :: table
integer :: stat
- type(dependency_t) :: dependency
+ type(dependency_config_t) :: dependency
call new_table(table)
table%key = 'example'
@@ -275,7 +275,7 @@ contains
type(toml_table) :: table
integer :: stat
- type(dependency_t) :: dependency
+ type(dependency_config_t) :: dependency
call new_table(table)
table%key = 'example'
@@ -297,7 +297,7 @@ contains
type(toml_table) :: table
integer :: stat
- type(dependency_t) :: dependency
+ type(dependency_config_t) :: dependency
call new_table(table)
table%key = 'example'
@@ -320,7 +320,7 @@ contains
type(toml_table) :: table
integer :: stat
- type(dependency_t) :: dependency
+ type(dependency_config_t) :: dependency
call new_table(table)
table%key = 'example'
@@ -340,7 +340,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(toml_table) :: table
- type(dependency_t), allocatable :: dependencies(:)
+ type(dependency_config_t), allocatable :: dependencies(:)
call new_table(table)
@@ -365,7 +365,7 @@ contains
type(toml_table) :: table
type(toml_array), pointer :: children
integer :: stat
- type(dependency_t), allocatable :: dependencies(:)
+ type(dependency_config_t), allocatable :: dependencies(:)
call new_table(table)
call add_array(table, 'dep1', children, stat)
@@ -384,7 +384,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(toml_table) :: table
- type(executable_t) :: executable
+ type(executable_config_t) :: executable
call new_table(table)
@@ -404,7 +404,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(executable_t) :: executable
+ type(executable_config_t) :: executable
call new_table(table)
call add_table(table, 'name', child, stat)
@@ -425,7 +425,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(executable_t) :: executable
+ type(executable_config_t) :: executable
call new_table(table)
call add_table(table, 'dependencies', child, stat)
@@ -446,7 +446,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(executable_t) :: executable
+ type(executable_config_t) :: executable
call new_table(table)
call add_table(table, 'wrong-field', child, stat)
@@ -457,12 +457,12 @@ contains
!> Try to read values from the [build] table
- subroutine test_build_config_valid(error)
+ subroutine test_build_valid(error)
!> Error handling
type(error_t), allocatable, intent(out) :: error
- type(package_t) :: package
+ type(package_config_t) :: package
character(:), allocatable :: temp_file
integer :: unit
@@ -480,26 +480,26 @@ contains
if (allocated(error)) return
- if (package%build_config%auto_executables) then
+ if (package%build%auto_executables) then
call test_failed(error, "Wong value of 'auto-executables' read, expecting .false.")
return
end if
- if (package%build_config%auto_tests) then
+ if (package%build%auto_tests) then
call test_failed(error, "Wong value of 'auto-tests' read, expecting .false.")
return
end if
- end subroutine test_build_config_valid
+ end subroutine test_build_valid
!> Try to read values from an empty [build] table
- subroutine test_build_config_empty(error)
+ subroutine test_build_empty(error)
!> Error handling
type(error_t), allocatable, intent(out) :: error
- type(package_t) :: package
+ type(package_config_t) :: package
character(:), allocatable :: temp_file
integer :: unit
@@ -516,26 +516,26 @@ contains
if (allocated(error)) return
- if (.not.package%build_config%auto_executables) then
+ if (.not.package%build%auto_executables) then
call test_failed(error, "Wong default value of 'auto-executables' read, expecting .true.")
return
end if
- if (.not.package%build_config%auto_tests) then
+ if (.not.package%build%auto_tests) then
call test_failed(error, "Wong default value of 'auto-tests' read, expecting .true.")
return
end if
- end subroutine test_build_config_empty
+ end subroutine test_build_empty
!> Try to read values from a [build] table with invalid values
- subroutine test_build_config_invalid_values(error)
+ subroutine test_build_invalid_values(error)
!> Error handling
type(error_t), allocatable, intent(out) :: error
- type(package_t) :: package
+ type(package_config_t) :: package
character(:), allocatable :: temp_file
integer :: unit
@@ -550,7 +550,7 @@ contains
call get_package_data(package, temp_file, error)
- end subroutine test_build_config_invalid_values
+ end subroutine test_build_invalid_values
!> Libraries can be created from empty tables
@@ -562,7 +562,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(toml_table) :: table
- type(library_t) :: library
+ type(library_config_t) :: library
call new_table(table)
@@ -587,7 +587,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(library_t) :: library
+ type(library_config_t) :: library
call new_table(table)
call add_table(table, 'not-allowed', child, stat)
@@ -610,7 +610,7 @@ contains
type(toml_table), pointer :: child, child2
type(toml_array), pointer :: children
integer :: stat
- type(package_t) :: package
+ type(package_config_t) :: package
call new_table(table)
call set_value(table, 'name', '"example"', stat)
@@ -645,7 +645,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(toml_table) :: table
- type(package_t) :: package
+ type(package_config_t) :: package
call new_table(table)
@@ -665,7 +665,7 @@ contains
type(toml_table) :: table
type(toml_array), pointer :: child
integer :: stat
- type(package_t) :: package
+ type(package_config_t) :: package
call new_table(table)
call add_array(table, "name", child, stat)
@@ -686,7 +686,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(package_t) :: package
+ type(package_config_t) :: package
call new_table(table)
call add_table(table, "library", child, stat)
@@ -709,7 +709,7 @@ contains
type(toml_table) :: table
type(toml_array), pointer :: children, children2
integer :: stat
- type(package_t) :: package
+ type(package_config_t) :: package
call new_table(table)
call set_value(table, 'name', '"example"', stat)
@@ -732,7 +732,7 @@ contains
type(toml_table) :: table
type(toml_array), pointer :: children, children2
integer :: stat
- type(package_t) :: package
+ type(package_config_t) :: package
call new_table(table)
call set_value(table, 'name', '"example"', stat)
@@ -755,7 +755,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(test_t) :: test
+ type(test_config_t) :: test
call new_table(table)
call set_value(table, 'name', '"example"', stat)
@@ -781,7 +781,7 @@ contains
type(error_t), allocatable, intent(out) :: error
type(toml_table) :: table
- type(test_t) :: test
+ type(test_config_t) :: test
call new_table(table)
@@ -801,7 +801,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(test_t) :: test
+ type(test_config_t) :: test
call new_table(table)
call add_table(table, 'name', child, stat)
@@ -822,7 +822,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(test_t) :: test
+ type(test_config_t) :: test
call new_table(table)
call add_table(table, 'dependencies', child, stat)
@@ -843,7 +843,7 @@ contains
type(toml_table) :: table
type(toml_table), pointer :: child
integer :: stat
- type(test_t) :: test
+ type(test_config_t) :: test
call new_table(table)
call add_table(table, 'not-supported', child, stat)
@@ -855,7 +855,7 @@ contains
!> Test link options
subroutine test_link_string(error)
- use fpm_manifest_build_config
+ use fpm_manifest_build
use fpm_toml, only : set_value, toml_table
!> Error handling
@@ -875,7 +875,7 @@ contains
!> Test link options
subroutine test_link_array(error)
- use fpm_manifest_build_config
+ use fpm_manifest_build
use fpm_toml, only : add_array, set_value, toml_table, toml_array
!> Error handling
@@ -898,7 +898,7 @@ contains
!> Test link options
subroutine test_invalid_link(error)
- use fpm_manifest_build_config
+ use fpm_manifest_build
use fpm_toml, only : add_table, toml_table
!> Error handling