diff options
| -rw-r--r-- | fpm/fpm.toml | 2 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/dependency.f90 | 10 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/executable.f90 | 5 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/library.f90 | 2 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/package.f90 | 6 | ||||
| -rw-r--r-- | fpm/src/fpm/manifest/test.f90 | 3 | ||||
| -rw-r--r-- | fpm/src/fpm/toml.f90 | 8 | ||||
| -rw-r--r-- | fpm/test/test_manifest.f90 | 508 | ||||
| -rw-r--r-- | fpm/test/testsuite.f90 | 29 |
9 files changed, 520 insertions, 53 deletions
diff --git a/fpm/fpm.toml b/fpm/fpm.toml index b39d881..5e0c884 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -8,7 +8,7 @@ copyright = "2020 fpm contributors" [dependencies] [dependencies.toml-f] git = "https://github.com/toml-f/toml-f" -rev = "290ba87671ab593e7bd51599e1d80ea736b3cd36" +rev = "d7371fc8de004e34ac1d461a0d590f6015545168" [[test]] name = "fpm-test" diff --git a/fpm/src/fpm/manifest/dependency.f90 b/fpm/src/fpm/manifest/dependency.f90 index 8a3d879..599d43a 100644 --- a/fpm/src/fpm/manifest/dependency.f90 +++ b/fpm/src/fpm/manifest/dependency.f90 @@ -94,7 +94,7 @@ contains end if if (.not.allocated(self%git)) then - call get_value(table, "revision", obj) + call get_value(table, "rev", obj) if (allocated(obj)) then self%git = git_target_revision(url, obj) end if @@ -120,9 +120,10 @@ contains character(len=:), allocatable :: name type(toml_key), allocatable :: list(:) - logical :: url_present, git_target_present + logical :: url_present, git_target_present, has_path integer :: ikey + has_path = .false. url_present = .false. git_target_present = .false. @@ -146,6 +147,7 @@ contains exit end if url_present = .true. + has_path = list(ikey)%key == 'path' case("branch", "rev", "tag") if (git_target_present) then @@ -163,7 +165,7 @@ contains return end if - if (.not.url_present .and. git_target_present) then + if (has_path .and. git_target_present) then call syntax_error(error, "Dependency "//name//" uses a local path, therefore no git identifiers are allowed") end if @@ -182,7 +184,7 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - class(toml_table), pointer :: node + type(toml_table), pointer :: node type(toml_key), allocatable :: list(:) integer :: idep, stat diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 index f706001..6675519 100644 --- a/fpm/src/fpm/manifest/executable.f90 +++ b/fpm/src/fpm/manifest/executable.f90 @@ -57,7 +57,7 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - class(toml_table), pointer :: child + type(toml_table), pointer :: child call check(table, error) if (allocated(error)) return @@ -104,7 +104,7 @@ contains 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") + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed as executable entry") exit case("name") @@ -115,6 +115,7 @@ contains end select end do + if (allocated(error)) return if (.not.name_present) then call syntax_error(error, "Executable name is not provided, please add a name entry") diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90 index 40e5e92..7a79a2a 100644 --- a/fpm/src/fpm/manifest/library.f90 +++ b/fpm/src/fpm/manifest/library.f90 @@ -77,7 +77,7 @@ contains 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") + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in library") exit case("source-dir", "build-script") diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index 4c2c14a..349a9a8 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -85,8 +85,8 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - class(toml_table), pointer :: child, node - class(toml_array), pointer :: children + type(toml_table), pointer :: child, node + type(toml_array), pointer :: children integer :: ii, nn, stat call check(table, error) @@ -185,7 +185,7 @@ contains case("version", "license", "author", "maintainer", "copyright", & & "dependencies", "dev-dependencies", "test", "executable", & - & "library") + & "description", "keywords", "categories", "library") continue end select diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 index a6c6f64..de4c847 100644 --- a/fpm/src/fpm/manifest/test.f90 +++ b/fpm/src/fpm/manifest/test.f90 @@ -50,7 +50,7 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - class(toml_table), pointer :: child + type(toml_table), pointer :: child call check(table, error) if (allocated(error)) return @@ -108,6 +108,7 @@ contains end select end do + if (allocated(error)) return if (.not.name_present) then call syntax_error(error, "Test name is not provided, please add a name entry") diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90 index 183278d..ca14a3c 100644 --- a/fpm/src/fpm/toml.f90 +++ b/fpm/src/fpm/toml.f90 @@ -14,14 +14,14 @@ 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 : new_table, len + & set_value, toml_parse, toml_error + use tomlf_type, only : new_table, add_table, add_array, len implicit none private public :: read_package_file - public :: toml_table, toml_array, toml_key, toml_stat, get_value - public :: new_table, len + public :: toml_table, toml_array, toml_key, toml_stat, get_value, set_value + public :: new_table, add_table, add_array, len contains diff --git a/fpm/test/test_manifest.f90 b/fpm/test/test_manifest.f90 index 223b346..c47ecba 100644 --- a/fpm/test/test_manifest.f90 +++ b/fpm/test/test_manifest.f90 @@ -1,6 +1,7 @@ !> Define tests for the `fpm_manifest` modules module test_manifest - use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & + & check_string use fpm_manifest implicit none private @@ -23,11 +24,30 @@ contains & new_unittest("default-library", test_default_library), & & new_unittest("default-executable", test_default_executable), & & new_unittest("dependency-empty", test_dependency_empty, should_fail=.true.), & + & new_unittest("dependency-pathtag", test_dependency_pathtag, should_fail=.true.), & + & new_unittest("dependency-gitpath", test_dependency_gitpath, should_fail=.true.), & + & new_unittest("dependency-nourl", test_dependency_nourl, should_fail=.true.), & + & new_unittest("dependency-gitconflict", test_dependency_gitconflict, should_fail=.true.), & + & new_unittest("dependency-wrongkey", test_dependency_wrongkey, should_fail=.true.), & & new_unittest("dependencies-empty", test_dependencies_empty), & + & new_unittest("dependencies-typeerror", test_dependencies_typeerror, should_fail=.true.), & & new_unittest("executable-empty", test_executable_empty, should_fail=.true.), & + & 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("library-empty", test_library_empty), & + & new_unittest("library-wrongkey", test_library_wrongkey, should_fail=.true.), & + & new_unittest("package-simple", test_package_simple), & & new_unittest("package-empty", test_package_empty, should_fail=.true.), & - & new_unittest("test-empty", test_test_empty, should_fail=.true.)] + & new_unittest("package-typeerror", test_package_typeerror, should_fail=.true.), & + & new_unittest("package-noname", test_package_noname, should_fail=.true.), & + & new_unittest("package-wrongexe", test_package_wrongexe, should_fail=.true.), & + & new_unittest("package-wrongtest", test_package_wrongtest, should_fail=.true.), & + & new_unittest("test-simple", test_test_simple), & + & new_unittest("test-empty", test_test_empty, should_fail=.true.), & + & new_unittest("test-typeerror", test_test_typeerror, should_fail=.true.), & + & new_unittest("test-noname", test_test_noname, should_fail=.true.), & + & new_unittest("test-wrongkey", test_test_wrongkey, should_fail=.true.)] end subroutine collect_manifest @@ -143,16 +163,9 @@ contains allocate(package%library) call default_library(package%library) - if (.not.allocated(package%library%source_dir)) then - call test_failed(error, "Default library source-dir is not set") - return - end if - - if (package%library%source_dir /= "src") then - call test_failed(error, "Default library source-dir is "// & - & package%library%source_dir//" but should be src") - return - end if + call check_string(error, package%library%source_dir, "src", & + & "Default library source-dir") + if (allocated(error)) return end subroutine test_default_library @@ -169,22 +182,13 @@ contains allocate(package%executable(1)) call default_executable(package%executable(1), name) - if (.not.allocated(package%executable(1)%source_dir)) then - call test_failed(error, "Default executable source-dir is not set") - return - end if - - if (package%executable(1)%source_dir /= "app") then - call test_failed(error, "Default executable source-dir is "// & - & package%executable(1)%source_dir//" but should be app") - return - end if + call check_string(error, package%executable(1)%source_dir, "app", & + & "Default executable source-dir") + if (allocated(error)) return - if (package%executable(1)%name /= name) then - call test_failed(error, "Default executable name is "// & - & package%executable(1)%name//" but should be "//name) - return - end if + call check_string(error, package%executable(1)%name, name, & + & "Default executable name") + if (allocated(error)) return end subroutine test_default_executable @@ -208,6 +212,115 @@ contains end subroutine test_dependency_empty + !> Try to create a dependency with conflicting entries + subroutine test_dependency_pathtag(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'path', '"package"', stat) + call set_value(table, 'tag', '"v20.1"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_pathtag + + + !> Try to create a dependency with conflicting entries + subroutine test_dependency_nourl(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'tag', '"v20.1"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_nourl + + + !> Try to create a dependency with conflicting entries + subroutine test_dependency_gitpath(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'path', '"package"', stat) + call set_value(table, 'git', '"https://gitea.com/fortran-lang/pack"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_gitpath + + + !> Try to create a dependency with conflicting entries + subroutine test_dependency_gitconflict(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'git', '"https://gitea.com/fortran-lang/pack"', stat) + call set_value(table, 'branch', '"latest"', stat) + call set_value(table, 'tag', '"v20.1"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_gitconflict + + + !> Try to create a dependency with conflicting entries + subroutine test_dependency_wrongkey(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table, set_value + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(dependency_t) :: dependency + + call new_table(table) + table%key = 'example' + call set_value(table, 'not-available', '"anywhere"', stat) + + call new_dependency(dependency, table, error) + + end subroutine test_dependency_wrongkey + + !> Dependency tables can be empty subroutine test_dependencies_empty(error) use fpm_manifest_dependency @@ -231,6 +344,27 @@ contains end subroutine test_dependencies_empty + !> Add a dependency as an array, which is not supported + subroutine test_dependencies_typeerror(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, add_array, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_array), pointer :: children + integer :: stat + type(dependency_t), allocatable :: dependencies(:) + + call new_table(table) + call add_array(table, 'dep1', children, stat) + + call new_dependencies(dependencies, table, error) + + end subroutine test_dependencies_typeerror + + !> Executables cannot be created from empty tables subroutine test_executable_empty(error) use fpm_manifest_executable @@ -249,6 +383,69 @@ contains end subroutine test_executable_empty + !> Pass a wrong TOML type to the name field of the executable + subroutine test_executable_typeerror(error) + use fpm_manifest_executable + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(executable_t) :: executable + + call new_table(table) + call add_table(table, 'name', child, stat) + + call new_executable(executable, table, error) + + end subroutine test_executable_typeerror + + + !> Pass a TOML table with insufficient entries to the executable constructor + subroutine test_executable_noname(error) + use fpm_manifest_executable + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(executable_t) :: executable + + call new_table(table) + call add_table(table, 'dependencies', child, stat) + + call new_executable(executable, table, error) + + end subroutine test_executable_noname + + + !> Pass a TOML table with not allowed keys + subroutine test_executable_wrongkey(error) + use fpm_manifest_executable + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(executable_t) :: executable + + call new_table(table) + call add_table(table, 'wrong-field', child, stat) + + call new_executable(executable, table, error) + + end subroutine test_executable_wrongkey + + !> Libraries can be created from empty tables subroutine test_library_empty(error) use fpm_manifest_library @@ -265,20 +462,73 @@ contains call new_library(library, table, error) if (allocated(error)) return - if (.not.allocated(library%source_dir)) then - call test_failed(error, "Default library source-dir is not set") - return - end if - - if (library%source_dir /= "src") then - call test_failed(error, "Default library source-dir is "// & - & library%source_dir//" but should be src") - return - end if + call check_string(error, library%source_dir, "src", & + & "Default library source-dir") + if (allocated(error)) return end subroutine test_library_empty + !> Pass a TOML table with not allowed keys + subroutine test_library_wrongkey(error) + use fpm_manifest_library + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(library_t) :: library + + call new_table(table) + call add_table(table, 'not-allowed', child, stat) + + call new_library(library, table, error) + + end subroutine test_library_wrongkey + + + !> Packages cannot be created from empty tables + subroutine test_package_simple(error) + use fpm_manifest_package + use fpm_toml, only : new_table, add_table, add_array, set_value, & + & toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child, child2 + type(toml_array), pointer :: children + integer :: stat + type(package_t) :: package + + call new_table(table) + call set_value(table, 'name', '"example"', stat) + call set_value(table, 'license', '"MIT"', stat) + call add_table(table, 'dev-dependencies', child, stat) + call add_table(child, 'pkg1', child2, stat) + call set_value(child2, 'git', '"https://github.com/fortran-lang/pkg1"', stat) + call add_table(child, 'pkg2', child2) + call set_value(child2, 'git', '"https://gitlab.com/fortran-lang/pkg2"', stat) + call set_value(child2, 'branch', '"devel"', stat) + call add_table(child, 'pkg3', child2) + call set_value(child2, 'git', '"https://bitbucket.org/fortran-lang/pkg3"', stat) + call set_value(child2, 'rev', '"9fceb02d0ae598e95dc970b74767f19372d61af8"', stat) + call add_table(child, 'pkg4', child2) + call set_value(child2, 'git', '"https://gitea.com/fortran-lang/pkg4"', stat) + call set_value(child2, 'tag', '"v1.8.5-rc3"', stat) + call add_array(table, 'test', children, stat) + call add_table(children, child, stat) + call set_value(child, 'name', '"tester"', stat) + + call new_package(package, table, error) + + end subroutine test_package_simple + + !> Packages cannot be created from empty tables subroutine test_package_empty(error) use fpm_manifest_package @@ -297,6 +547,127 @@ contains end subroutine test_package_empty + !> Create an array in the package name, which should cause an error + subroutine test_package_typeerror(error) + use fpm_manifest_package + use fpm_toml, only : new_table, add_array, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_array), pointer :: child + integer :: stat + type(package_t) :: package + + call new_table(table) + call add_array(table, "name", child, stat) + + call new_package(package, table, error) + + end subroutine test_package_typeerror + + + !> Try to create a new package without a name field + subroutine test_package_noname(error) + use fpm_manifest_package + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(package_t) :: package + + call new_table(table) + call add_table(table, "library", child, stat) + call add_table(table, "dev-dependencies", child, stat) + call add_table(table, "dependencies", child, stat) + + call new_package(package, table, error) + + end subroutine test_package_noname + + + !> Try to read executables from a mixed type array + subroutine test_package_wrongexe(error) + use fpm_manifest_package + use fpm_toml, only : new_table, set_value, add_array, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + type(toml_array), pointer :: children, children2 + integer :: stat + type(package_t) :: package + + call new_table(table) + call set_value(table, 'name', '"example"', stat) + call add_array(table, 'executable', children, stat) + call add_array(children, children2, stat) + + call new_package(package, table, error) + + end subroutine test_package_wrongexe + + + !> Try to read tests from a mixed type array + subroutine test_package_wrongtest(error) + use fpm_manifest_package + use fpm_toml, only : new_table, set_value, add_array, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + type(toml_array), pointer :: children, children2 + integer :: stat + type(package_t) :: package + + call new_table(table) + call set_value(table, 'name', '"example"', stat) + call add_array(table, 'test', children, stat) + call add_array(children, children2, stat) + + call new_package(package, table, error) + + end subroutine test_package_wrongtest + + + !> Tests cannot be created from empty tables + subroutine test_test_simple(error) + use fpm_manifest_test + use fpm_toml, only : new_table, set_value, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + character(len=:), allocatable :: name + integer :: stat + type(test_t) :: test + + call new_table(table) + call set_value(table, 'name', '"example"', stat) + call set_value(table, 'source-dir', '"tests"', stat) + call set_value(table, 'main', '"tester.f90"', stat) + call add_table(table, 'dependencies', child, stat) + + call new_test(test, table, error) + if (allocated(error)) return + + call check_string(error, test%main, "tester.f90", "Test main") + if (allocated(error)) return + + end subroutine test_test_simple + + !> Tests cannot be created from empty tables subroutine test_test_empty(error) use fpm_manifest_test @@ -315,4 +686,67 @@ contains end subroutine test_test_empty + !> Pass a wrong TOML type to the name field of the test + subroutine test_test_typeerror(error) + use fpm_manifest_test + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(test_t) :: test + + call new_table(table) + call add_table(table, 'name', child, stat) + + call new_test(test, table, error) + + end subroutine test_test_typeerror + + + !> Pass a TOML table with insufficient entries to the test constructor + subroutine test_test_noname(error) + use fpm_manifest_test + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(test_t) :: test + + call new_table(table) + call add_table(table, 'dependencies', child, stat) + + call new_test(test, table, error) + + end subroutine test_test_noname + + + !> Pass a TOML table with not allowed keys + subroutine test_test_wrongkey(error) + use fpm_manifest_test + use fpm_toml, only : new_table, add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(test_t) :: test + + call new_table(table) + call add_table(table, 'not-supported', child, stat) + + call new_test(test, table, error) + + end subroutine test_test_wrongkey + + end module test_manifest diff --git a/fpm/test/testsuite.f90 b/fpm/test/testsuite.f90 index bd0d415..411fa24 100644 --- a/fpm/test/testsuite.f90 +++ b/fpm/test/testsuite.f90 @@ -5,6 +5,7 @@ module testsuite private public :: run_testsuite, new_unittest, test_failed + public :: check_string public :: unittest_t, error_t @@ -119,4 +120,32 @@ contains end function new_unittest + !> Check a deferred length character variable against a reference value + subroutine check_string(error, actual, expected, name) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Actual string value + character(len=:), allocatable, intent(in) :: actual + + !> Expected string value + character(len=*), intent(in) :: expected + + !> Name of the string to check + character(len=*), intent(in) :: name + + if (.not.allocated(actual)) then + call test_failed(error, name//" is not set correctly") + return + end if + + if (actual /= expected) then + call test_failed(error, name//" is "//actual// & + & " but should be "//expected) + end if + + end subroutine check_string + + end module testsuite |