diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 987b282449..d84a00f1c5 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -150,6 +150,10 @@ pushd preprocess_cpp_deps "$fpm" build popd +pushd preprocess_per_dependency +"$fpm" run +popd + pushd preprocess_hello "$fpm" build popd diff --git a/example_packages/preprocess_per_dependency/app/main.f90 b/example_packages/preprocess_per_dependency/app/main.f90 new file mode 100644 index 0000000000..aed30cd33d --- /dev/null +++ b/example_packages/preprocess_per_dependency/app/main.f90 @@ -0,0 +1,8 @@ +program hello_fpm + use utils, only: say_hello + integer :: ierr + + call say_hello(ierr) + stop ierr ! ierr==0 if DEPENDENCY_MACRO is defined + +end program hello_fpm diff --git a/example_packages/preprocess_per_dependency/crate/utils/fpm.toml b/example_packages/preprocess_per_dependency/crate/utils/fpm.toml new file mode 100644 index 0000000000..f3c03f9934 --- /dev/null +++ b/example_packages/preprocess_per_dependency/crate/utils/fpm.toml @@ -0,0 +1,5 @@ +name = "utils" + +[preprocess] +[preprocess.cpp] +macros = ["X=1"] diff --git a/example_packages/preprocess_per_dependency/crate/utils/src/say_hello.f90 b/example_packages/preprocess_per_dependency/crate/utils/src/say_hello.f90 new file mode 100644 index 0000000000..5f333bab7e --- /dev/null +++ b/example_packages/preprocess_per_dependency/crate/utils/src/say_hello.f90 @@ -0,0 +1,19 @@ +module utils + + implicit none + +contains + + subroutine say_hello(ierr) + integer, intent(out) :: ierr + + ierr = -1 +#ifdef DEPENDENCY_MACRO + ierr = 0 +#endif + + print *, "Dependency macro ", merge(" IS","NOT",ierr==0)," defined" + + end subroutine say_hello + +end module utils diff --git a/example_packages/preprocess_per_dependency/fpm.toml b/example_packages/preprocess_per_dependency/fpm.toml new file mode 100644 index 0000000000..4730973ab1 --- /dev/null +++ b/example_packages/preprocess_per_dependency/fpm.toml @@ -0,0 +1,4 @@ +name = "preprocess_cpp_deps" + +[dependencies] +utils = { path = "crate/utils" , preprocess.cpp.macros=["DEPENDENCY_MACRO"] } diff --git a/src/fpm.f90 b/src/fpm.f90 index 129c4c95dc..0a2712e612 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -109,12 +109,30 @@ subroutine build_model(model, settings, package, error) end associate model%packages(i)%version = package%version%s() + !> Add this dependency's manifest macros + allocate(model%packages(i)%macros(0)) + if (allocated(dependency%preprocess)) then do j = 1, size(dependency%preprocess) if (dependency%preprocess(j)%name == "cpp") then if (.not. has_cpp) has_cpp = .true. if (allocated(dependency%preprocess(j)%macros)) then - model%packages(i)%macros = dependency%preprocess(j)%macros + model%packages(i)%macros = [model%packages(i)%macros, dependency%preprocess(j)%macros] + end if + else + write(stderr, '(a)') 'Warning: Preprocessor ' // package%preprocess(i)%name // & + ' is not supported; will ignore it' + end if + end do + end if + + !> Add this dependency's package-level macros + if (allocated(dep%preprocess)) then + do j = 1, size(dep%preprocess) + if (dep%preprocess(j)%name == "cpp") then + if (.not. has_cpp) has_cpp = .true. + if (allocated(dep%preprocess(j)%macros)) then + model%packages(i)%macros = [model%packages(i)%macros, dep%preprocess(j)%macros] end if else write(stderr, '(a)') 'Warning: Preprocessor ' // package%preprocess(i)%name // & diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index af6860a0ac..52e5c6ec12 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -63,6 +63,7 @@ module fpm_dependency use fpm_git, only: git_target_revision, git_target_default, git_revision, operator(==) use fpm_manifest, only: package_config_t, dependency_config_t, get_package_data use fpm_manifest_dependency, only: manifest_has_changed + use fpm_manifest_preprocess, only: operator(==) use fpm_strings, only: string_t, operator(.in.) use fpm_toml, only: toml_table, toml_key, toml_error, toml_serialize, & get_value, set_value, add_table, toml_load, toml_stat @@ -1187,6 +1188,8 @@ logical function dependency_has_changed(cached, manifest, verbosity, iunit) resu !> Log verbosity integer, intent(in) :: verbosity, iunit + integer :: ip + has_changed = .true. !> All the following entities must be equal for the dependency to not have changed @@ -1219,6 +1222,23 @@ logical function dependency_has_changed(cached, manifest, verbosity, iunit) resu else if (verbosity > 1) write (iunit, out_fmt) "PROJECT DIR has changed presence " end if + if (allocated(cached%preprocess) .eqv. allocated(manifest%preprocess)) then + if (allocated(cached%preprocess)) then + if (size(cached%preprocess) /= size(manifest%preprocess)) then + if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS has changed size" + return + end if + do ip=1,size(cached%preprocess) + if (.not.(cached%preprocess(ip) == manifest%preprocess(ip))) then + if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS config has changed" + return + end if + end do + endif + else + if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS has changed presence " + return + end if !> All checks passed: the two dependencies have no differences has_changed = .false. diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 75f5f5d10d..de4f104db9 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -32,6 +32,8 @@ module fpm_manifest_dependency use fpm_manifest_metapackages, only: metapackage_config_t, is_meta_package, new_meta_config, & metapackage_request_t, new_meta_request use fpm_versioning, only: version_t, new_version + use fpm_strings, only: string_t + use fpm_manifest_preprocess implicit none private @@ -55,6 +57,9 @@ module fpm_manifest_dependency !> The latest version is used if not specified. type(version_t), allocatable :: requested_version + !> Requested macros for the dependency + type(preprocess_config_t), allocatable :: preprocess(:) + !> Git descriptor type(git_target_t), allocatable :: git @@ -87,12 +92,28 @@ subroutine new_dependency(self, table, root, error) character(len=:), allocatable :: uri, value, requested_version + type(toml_table), pointer :: child + call check(table, error) if (allocated(error)) return call table%get_key(self%name) call get_value(table, "namespace", self%namespace) + call get_value(table, "v", requested_version) + if (allocated(requested_version)) then + if (.not. allocated(self%requested_version)) allocate (self%requested_version) + call new_version(self%requested_version, requested_version, error) + if (allocated(error)) return + end if + + !> Get optional preprocessor directives + call get_value(table, "preprocess", child, requested=.false.) + if (associated(child)) then + call new_preprocessors(self%preprocess, child, error) + if (allocated(error)) return + endif + call get_value(table, "path", uri) if (allocated(uri)) then if (get_os_type() == OS_WINDOWS) uri = windows_path(uri) @@ -128,14 +149,6 @@ subroutine new_dependency(self, table, root, error) return end if - call get_value(table, "v", requested_version) - - if (allocated(requested_version)) then - if (.not. allocated(self%requested_version)) allocate (self%requested_version) - call new_version(self%requested_version, requested_version, error) - if (allocated(error)) return - end if - end subroutine new_dependency !> Check local schema for allowed entries @@ -149,6 +162,7 @@ subroutine check(table, error) character(len=:), allocatable :: name type(toml_key), allocatable :: list(:) + type(toml_table), pointer :: child !> List of valid keys for the dependency table. character(*), dimension(*), parameter :: valid_keys = [character(24) :: & @@ -158,7 +172,8 @@ subroutine check(table, error) "git", & "tag", & "branch", & - "rev" & + "rev", & + "preprocess" & & ] call table%get_key(name) @@ -202,6 +217,18 @@ subroutine check(table, error) return end if + ! Check preprocess key + if (table%has_key('preprocess')) then + + call get_value(table, 'preprocess', child) + + if (.not.associated(child)) then + call syntax_error(error, "Dependency '"//name//"' has invalid 'preprocess' entry") + return + end if + + end if + end subroutine check !> Construct new dependency array from a TOML data structure diff --git a/src/fpm/manifest/preprocess.f90 b/src/fpm/manifest/preprocess.f90 index 538652c29a..3f9754725a 100644 --- a/src/fpm/manifest/preprocess.f90 +++ b/src/fpm/manifest/preprocess.f90 @@ -17,7 +17,7 @@ module fpm_manifest_preprocess implicit none private - public :: preprocess_config_t, new_preprocess_config, new_preprocessors + public :: preprocess_config_t, new_preprocess_config, new_preprocessors, operator(==) !> Configuration meta data for a preprocessor type :: preprocess_config_t @@ -41,6 +41,10 @@ module fpm_manifest_preprocess end type preprocess_config_t + interface operator(==) + module procedure preprocess_is_same + end interface + contains !> Construct a new preprocess configuration from TOML data structure @@ -154,7 +158,7 @@ subroutine info(self, unit, verbosity) pr = 1 end if - if (pr < 1) return + if (pr < 1) return write(unit, fmt) "Preprocessor" if (allocated(self%name)) then @@ -181,4 +185,47 @@ subroutine info(self, unit, verbosity) end subroutine info + logical function preprocess_is_same(this,that) + class(preprocess_config_t), intent(in) :: this + class(preprocess_config_t), intent(in) :: that + + integer :: istr + + preprocess_is_same = .false. + + select type (other=>that) + type is (preprocess_config_t) + if (allocated(this%name).neqv.allocated(other%name)) return + if (allocated(this%name)) then + if (.not.(this%name==other%name)) return + endif + if (.not.(allocated(this%suffixes).eqv.allocated(other%suffixes))) return + if (allocated(this%suffixes)) then + do istr=1,size(this%suffixes) + if (.not.(this%suffixes(istr)%s==other%suffixes(istr)%s)) return + end do + end if + if (.not.(allocated(this%directories).eqv.allocated(other%directories))) return + if (allocated(this%directories)) then + do istr=1,size(this%directories) + if (.not.(this%directories(istr)%s==other%directories(istr)%s)) return + end do + end if + if (.not.(allocated(this%macros).eqv.allocated(other%macros))) return + if (allocated(this%macros)) then + do istr=1,size(this%macros) + if (.not.(this%macros(istr)%s==other%macros(istr)%s)) return + end do + end if + + class default + ! Not the same type + return + end select + + !> All checks passed! + preprocess_is_same = .true. + + end function preprocess_is_same + end module fpm_manifest_preprocess diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index f8d8ea2420..71cb148330 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -123,6 +123,7 @@ subroutine check_keys(table, valid_keys, error) type(error_t), allocatable, intent(out) :: error type(toml_key), allocatable :: keys(:) + type(toml_table), pointer :: child character(:), allocatable :: name, value, valid_keys_string integer :: ikey, ivalid @@ -143,12 +144,18 @@ subroutine check_keys(table, valid_keys, error) end if ! Check if value can be mapped or else (wrong type) show error message with the error location. - ! Right now, it can only be mapped to a string, but this can be extended in the future. + ! Right now, it can only be mapped to a string or to a child node, but this can be extended in the future. call get_value(table, keys(ikey)%key, value) if (.not. allocated(value)) then - allocate (error) - error%message = "'"//name//"' has an invalid '"//keys(ikey)%key//"' entry." - return + + ! If value is not a string, check if it is a child node + call get_value(table, keys(ikey)%key, child) + + if (.not.associated(child)) then + allocate (error) + error%message = "'"//name//"' has an invalid '"//keys(ikey)%key//"' entry." + return + endif end if end do diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 4f645750b5..0a5877a172 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -334,7 +334,6 @@ subroutine test_non_updated_dependencies(error) return end if - ! Test that dependency 3 is flagged as "not update" if (manifest_deps%dep(3)%update) then call test_failed(error, "Updated dependency (git rev) detected, should not be")