aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLKedward <laurence.kedward@bristol.ac.uk>2021-04-12 16:39:29 +0100
committerLKedward <laurence.kedward@bristol.ac.uk>2021-04-12 16:44:37 +0100
commita49b0177f8d7ca74b3bfaa325fd37ee614975367 (patch)
treed0455e6d9ebc1514a658d0d3142911dfe9b5d968
parent0d3611a5f3e7a2d7cb88ec8637a9d898b2ce4cfb (diff)
downloadfpm-a49b0177f8d7ca74b3bfaa325fd37ee614975367.tar.gz
fpm-a49b0177f8d7ca74b3bfaa325fd37ee614975367.zip
Add: external-modules key to build table for non-fpm modules
-rw-r--r--src/fpm.f905
-rw-r--r--src/fpm/manifest/build.f9016
-rw-r--r--src/fpm_model.f9010
-rw-r--r--src/fpm_targets.f9010
-rw-r--r--test/fpm_test/test_module_dependencies.f909
5 files changed, 46 insertions, 4 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90
index 31b68ff..a62ffe0 100644
--- a/src/fpm.f90
+++ b/src/fpm.f90
@@ -51,6 +51,7 @@ subroutine build_model(model, settings, package, error)
allocate(model%include_dirs(0))
allocate(model%link_libraries(0))
+ allocate(model%external_modules(0))
call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml"))
call model%deps%add(package, error)
@@ -171,6 +172,10 @@ subroutine build_model(model, settings, package, error)
if (allocated(dependency%build%link)) then
model%link_libraries = [model%link_libraries, dependency%build%link]
end if
+
+ if (allocated(dependency%build%external_modules)) then
+ model%external_modules = [model%external_modules, dependency%build%external_modules]
+ end if
end associate
end do
if (allocated(error)) return
diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90
index d96974f..c9b3f44 100644
--- a/src/fpm/manifest/build.f90
+++ b/src/fpm/manifest/build.f90
@@ -34,6 +34,9 @@ module fpm_manifest_build
!> Libraries to link against
type(string_t), allocatable :: link(:)
+ !> External modules to use
+ type(string_t), allocatable :: external_modules(:)
+
contains
!> Print information on this instance
@@ -87,6 +90,9 @@ contains
call get_value(table, "link", self%link, error)
if (allocated(error)) return
+ call get_value(table, "external-modules", self%external_modules, error)
+ if (allocated(error)) return
+
end subroutine new_build_config
@@ -110,7 +116,7 @@ contains
do ikey = 1, size(list)
select case(list(ikey)%key)
- case("auto-executables", "auto-examples", "auto-tests", "link")
+ case("auto-executables", "auto-examples", "auto-tests", "link", "external-modules")
continue
case default
@@ -135,7 +141,7 @@ contains
!> Verbosity of the printout
integer, intent(in), optional :: verbosity
- integer :: pr, ilink
+ integer :: pr, ilink, imod
character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)'
if (present(verbosity)) then
@@ -156,6 +162,12 @@ contains
write(unit, fmt) " - " // self%link(ilink)%s
end do
end if
+ if (allocated(self%external_modules)) then
+ write(unit, fmt) " - external modules"
+ do imod = 1, size(self%external_modules)
+ write(unit, fmt) " - " // self%external_modules(imod)%s
+ end do
+ end if
end subroutine info
diff --git a/src/fpm_model.f90 b/src/fpm_model.f90
index bfb0115..ec366d6 100644
--- a/src/fpm_model.f90
+++ b/src/fpm_model.f90
@@ -129,6 +129,9 @@ type :: fpm_model_t
!> Native libraries to link against
type(string_t), allocatable :: link_libraries(:)
+ !> External modules used
+ type(string_t), allocatable :: external_modules(:)
+
!> Project dependencies
type(dependency_tree_t) :: deps
@@ -276,6 +279,13 @@ function info_model(model) result(s)
if (i < size(model%link_libraries)) s = s // ", "
end do
s = s // "]"
+ ! type(string_t), allocatable :: external_modules(:)
+ s = s // ", external_modules=["
+ do i = 1, size(model%external_modules)
+ s = s // '"' // model%external_modules(i)%s // '"'
+ if (i < size(model%external_modules)) s = s // ", "
+ end do
+ s = s // "]"
! type(dependency_tree_t) :: deps
! TODO: print `dependency_tree_t` properly, which should become part of the
! model, not imported from another file
diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90
index 02bb600..671145d 100644
--- a/src/fpm_targets.f90
+++ b/src/fpm_targets.f90
@@ -121,7 +121,7 @@ subroutine targets_from_sources(targets,model,error)
call build_target_list(targets,model)
- call resolve_module_dependencies(targets,error)
+ call resolve_module_dependencies(targets,model%external_modules,error)
if (allocated(error)) return
call resolve_target_linking(targets,model)
@@ -345,8 +345,9 @@ end subroutine add_dependency
!> a source file in the package of the correct scope, then a __fatal error__
!> is returned by the procedure and model construction fails.
!>
-subroutine resolve_module_dependencies(targets,error)
+subroutine resolve_module_dependencies(targets,external_modules,error)
type(build_target_ptr), intent(inout), target :: targets(:)
+ type(string_t), intent(in) :: external_modules(:)
type(error_t), allocatable, intent(out) :: error
type(build_target_ptr) :: dep
@@ -364,6 +365,11 @@ subroutine resolve_module_dependencies(targets,error)
cycle
end if
+ if (targets(i)%ptr%source%modules_used(j)%s .in. external_modules) then
+ ! Dependency satisfied in system-installed module
+ cycle
+ end if
+
if (any(targets(i)%ptr%source%unit_scope == &
[FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST])) then
dep%ptr => &
diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90
index f193646..992f227 100644
--- a/test/fpm_test/test_module_dependencies.f90
+++ b/test/fpm_test/test_module_dependencies.f90
@@ -67,6 +67,7 @@ contains
type(build_target_ptr), allocatable :: targets(:)
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(2))
@@ -137,6 +138,7 @@ contains
character(:), allocatable :: scope_str
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(2))
@@ -196,6 +198,7 @@ contains
type(build_target_ptr), allocatable :: targets(:)
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(1))
@@ -249,6 +252,7 @@ contains
character(:), allocatable :: scope_str
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(3))
@@ -308,6 +312,7 @@ contains
type(build_target_ptr), allocatable :: targets(:)
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(2))
@@ -335,6 +340,7 @@ contains
type(build_target_ptr), allocatable :: targets(:)
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(2))
@@ -361,6 +367,7 @@ contains
type(build_target_ptr), allocatable :: targets(:)
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(2))
@@ -388,6 +395,7 @@ contains
type(build_target_ptr), allocatable :: targets(:)
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(2))
@@ -507,6 +515,7 @@ contains
type(build_target_ptr), allocatable :: targets(:)
model%output_directory = ''
+ allocate(model%external_modules(0))
allocate(model%packages(1))
allocate(model%packages(1)%sources(2))