diff --git a/src/fpm/manifest/library.f90 b/src/fpm/manifest/library.f90 index 52e33efecb..bc55f10c91 100644 --- a/src/fpm/manifest/library.f90 +++ b/src/fpm/manifest/library.f90 @@ -12,7 +12,7 @@ module fpm_manifest_library use fpm_error, only : error_t, syntax_error use fpm_strings, only: string_t, string_cat, operator(==) use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list, serializable_t, set_value, & - set_list, set_string, get_value, get_list + set_list, set_string, get_value, has_list implicit none private @@ -63,6 +63,11 @@ subroutine new_library(self, table, error) call check(table, error) if (allocated(error)) return + + if (has_list(table, "source-dir")) then + call syntax_error(error, "Manifest key [library.source-dir] does not allow list input") + return + end if call get_value(table, "source-dir", self%source_dir, "src") call get_value(table, "build-script", self%build_script) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index 1bbcfe9886..762a408784 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -28,7 +28,7 @@ module fpm_toml public :: read_package_file, toml_table, toml_array, toml_key, toml_stat, & get_value, set_value, get_list, new_table, add_table, add_array, len, & toml_error, toml_serialize, toml_load, check_keys, set_list, set_string, & - name_is_json + name_is_json, has_list !> An abstract interface for any fpm class that should be fully serializable to/from TOML/JSON type, abstract, public :: serializable_t @@ -337,6 +337,29 @@ subroutine read_package_file(table, manifest, error) end if end subroutine read_package_file + + !> Check if an instance of the TOML data structure contains a list + logical function has_list(table, key) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Key to read from + character(len=*), intent(in) :: key + + type(toml_array), pointer :: children + + has_list = .false. + + if (.not.table%has_key(key)) return + + call get_value(table, key, children, requested=.false.) + + ! There is an allocated list + has_list = associated(children) + + end function has_list + subroutine get_list(table, key, list, error) diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 316508d9bc..42d319228b 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -4,7 +4,7 @@ module test_manifest use testsuite, only : new_unittest, unittest_t, error_t, test_failed, check_string use fpm_manifest use fpm_manifest_profile, only: profile_config_t, find_profile - use fpm_strings, only: operator(.in.) + use fpm_strings, only: operator(.in.), string_t use fpm_error, only: fatal_error, error_t implicit none private @@ -46,6 +46,7 @@ subroutine collect_manifest(tests) & new_unittest("build-key-invalid", test_build_invalid_key), & & new_unittest("library-empty", test_library_empty), & & new_unittest("library-wrongkey", test_library_wrongkey, should_fail=.true.), & + & new_unittest("library-list", test_library_list, should_fail=.true.), & & new_unittest("package-simple", test_package_simple), & & new_unittest("package-empty", test_package_empty, should_fail=.true.), & & new_unittest("package-typeerror", test_package_typeerror, should_fail=.true.), & @@ -887,6 +888,47 @@ subroutine test_library_wrongkey(error) end subroutine test_library_wrongkey + !> Pass a TOML table with not allowed source dirs + subroutine test_library_list(error) + use fpm_manifest_library + use fpm_toml, only : new_table, set_list, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(string_t), allocatable :: source_dirs(:) + type(toml_table) :: table + type(library_config_t) :: library + + source_dirs = [string_t("src1"),string_t("src2")] + call new_table (table) + call set_list (table, "source-dir", source_dirs, error) + call new_library(library, table, error) + + end subroutine test_library_list + + !> Pass a TOML table with a 1-sized source dir list + subroutine test_library_listone(error) + use fpm_manifest_library + use fpm_toml, only : new_table, set_list, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[library]', & + & 'source-dir = ["my-src"]' + close(unit) + + call get_package_data(package, temp_file, error) + + end subroutine test_library_listone !> Packages cannot be created from empty tables subroutine test_package_simple(error)