aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--fpm/src/fpm.f9012
-rw-r--r--fpm/src/fpm/manifest.f903
-rw-r--r--fpm/src/fpm/manifest/library.f9016
-rw-r--r--fpm/src/fpm_strings.f906
-rw-r--r--fpm/test/fpm_test/test_manifest.f9025
-rw-r--r--manifest-reference.md8
6 files changed, 53 insertions, 17 deletions
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90
index 5b9c310..80fb576 100644
--- a/fpm/src/fpm.f90
+++ b/fpm/src/fpm.f90
@@ -39,7 +39,7 @@ subroutine build_model(model, settings, package, error)
type(package_config_t), intent(in) :: package
type(error_t), allocatable, intent(out) :: error
- integer :: i
+ integer :: i, j
type(package_config_t) :: dependency
character(len=:), allocatable :: manifest, lib_dir
type(string_t) :: include_dir
@@ -155,10 +155,12 @@ subroutine build_model(model, settings, package, error)
end if
if (allocated(dependency%library%include_dir)) then
- include_dir%s = join_path(dep%proj_dir, dependency%library%include_dir)
- if (is_dir(include_dir%s)) then
- model%include_dirs = [model%include_dirs, include_dir]
- end if
+ do j=1,size(dependency%library%include_dir)
+ include_dir%s = join_path(dep%proj_dir, dependency%library%include_dir(j)%s)
+ if (is_dir(include_dir%s)) then
+ model%include_dirs = [model%include_dirs, include_dir]
+ end if
+ end do
end if
end if
diff --git a/fpm/src/fpm/manifest.f90 b/fpm/src/fpm/manifest.f90
index ef75941..4170b91 100644
--- a/fpm/src/fpm/manifest.f90
+++ b/fpm/src/fpm/manifest.f90
@@ -17,6 +17,7 @@ module fpm_manifest
use fpm_toml, only : toml_table, read_package_file
use fpm_manifest_test, only : test_config_t
use fpm_filesystem, only: join_path, exists, dirname, is_dir
+ use fpm_strings, only: string_t
implicit none
private
@@ -35,7 +36,7 @@ contains
type(library_config_t), intent(out) :: self
self%source_dir = "src"
- self%include_dir = "include"
+ self%include_dir = [string_t("include")]
end subroutine default_library
diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90
index 4bcd363..c8ce049 100644
--- a/fpm/src/fpm/manifest/library.f90
+++ b/fpm/src/fpm/manifest/library.f90
@@ -5,11 +5,12 @@
!>```toml
!>[library]
!>source-dir = "path"
-!>include-dir = "path"
+!>include-dir = ["path1","path2"]
!>build-script = "file"
!>```
module fpm_manifest_library
use fpm_error, only : error_t, syntax_error
+ use fpm_strings, only: string_t, string_cat
use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
implicit none
private
@@ -24,7 +25,7 @@ module fpm_manifest_library
character(len=:), allocatable :: source_dir
!> Include path prefix
- character(len=:), allocatable :: include_dir
+ type(string_t), allocatable :: include_dir(:)
!> Alternative build script to be invoked
character(len=:), allocatable :: build_script
@@ -56,9 +57,16 @@ contains
if (allocated(error)) return
call get_value(table, "source-dir", self%source_dir, "src")
- call get_value(table, "include-dir", self%include_dir, "include")
call get_value(table, "build-script", self%build_script)
+ call get_value(table, "include-dir", self%include_dir, error)
+ if (allocated(error)) return
+
+ ! Set default value of include-dir if not found in manifest
+ if (.not.allocated(self%include_dir)) then
+ self%include_dir = [string_t("include")]
+ end if
+
end subroutine new_library
@@ -122,7 +130,7 @@ contains
write(unit, fmt) "- source directory", self%source_dir
end if
if (allocated(self%include_dir)) then
- write(unit, fmt) "- include directory", self%include_dir
+ write(unit, fmt) "- include directory", string_cat(self%include_dir,",")
end if
if (allocated(self%build_script)) then
write(unit, fmt) "- custom build", self%build_script
diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90
index 2e3d69e..80950de 100644
--- a/fpm/src/fpm_strings.f90
+++ b/fpm/src/fpm_strings.f90
@@ -3,7 +3,7 @@ use iso_fortran_env, only: int64
implicit none
private
-public :: f_string, lower, split, str_ends_with, new_string_t, string_t
+public :: f_string, lower, split, str_ends_with, string_t
public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a
public :: replace, resize, str, join, glob
@@ -37,6 +37,10 @@ interface str
module procedure str_int, str_int64, str_logical
end interface
+interface string_t
+ module procedure new_string_t
+end interface string_t
+
contains
pure logical function str_ends_with_str(s, e) result(r)
diff --git a/fpm/test/fpm_test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90
index fc16d4d..94e5e07 100644
--- a/fpm/test/fpm_test/test_manifest.f90
+++ b/fpm/test/fpm_test/test_manifest.f90
@@ -4,6 +4,7 @@ module test_manifest
use testsuite, only : new_unittest, unittest_t, error_t, test_failed, &
& check_string
use fpm_manifest
+ use fpm_strings, only: operator(.in.)
implicit none
private
@@ -183,9 +184,15 @@ contains
& "Default library source-dir")
if (allocated(error)) return
- call check_string(error, package%library%include_dir, "include", &
- & "Default library include-dir")
- if (allocated(error)) return
+ if (.not.allocated(package%library%include_dir)) then
+ call test_failed(error,"Default include-dir list not allocated")
+ return
+ end if
+
+ if (.not.("include".in.package%library%include_dir)) then
+ call test_failed(error,"'include' not in default include-dir list")
+ return
+ end if
end subroutine test_default_library
@@ -583,9 +590,15 @@ contains
& "Default library source-dir")
if (allocated(error)) return
- call check_string(error, library%include_dir, "include", &
- & "Default library include-dir")
- if (allocated(error)) return
+ if (.not.allocated(library%include_dir)) then
+ call test_failed(error,"Default include-dir list not allocated")
+ return
+ end if
+
+ if (.not.("include".in.library%include_dir)) then
+ call test_failed(error,"'include' not in default include-dir list")
+ return
+ end if
end subroutine test_library_empty
diff --git a/manifest-reference.md b/manifest-reference.md
index 564fec0..97b415d 100644
--- a/manifest-reference.md
+++ b/manifest-reference.md
@@ -199,6 +199,14 @@ Paths for the source and include directories are given relative to the project r
source-dir = "lib"
include-dir = "inc"
```
+*include-dir* can contain one or more directories, where multiple directories are specified using a list of strings.
+
+*Example:*
+
+```toml
+[library]
+include-dir = ["include","third_party/include"]
+```
#### Custom build script