Constructs a valid fpm model from command line settings and the toml manifest. Add this dependency’s manifest macros
Add this dependency’s package-level macros
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(fpm_model_t), | intent(out) | :: | model | |||
class(fpm_build_settings), | intent(inout) | :: | settings | |||
type(package_config_t), | intent(inout) | :: | package | |||
type(error_t), | intent(out), | allocatable | :: | error |
subroutine build_model(model, settings, package, error)
type(fpm_model_t), intent(out) :: model
class(fpm_build_settings), intent(inout) :: settings
type(package_config_t), intent(inout) :: package
type(error_t), allocatable, intent(out) :: error
integer :: i, j
type(package_config_t) :: dependency
character(len=:), allocatable :: manifest, lib_dir
logical :: has_cpp
logical :: duplicates_found
type(string_t) :: include_dir
model%package_name = package%name
allocate(model%include_dirs(0))
allocate(model%link_libraries(0))
allocate(model%external_modules(0))
call new_compiler(model%compiler, settings%compiler, settings%c_compiler, &
& settings%cxx_compiler, echo=settings%verbose, verbose=settings%verbose)
call new_archiver(model%archiver, settings%archiver, &
& echo=settings%verbose, verbose=settings%verbose)
if (model%compiler%is_unknown()) then
write(*, '(*(a:,1x))') &
"<WARN>", "Unknown compiler", model%compiler%fc, "requested!", &
"Defaults for this compiler might be incorrect"
end if
call new_compiler_flags(model,settings)
model%build_prefix = join_path("build", basename(model%compiler%fc))
model%include_tests = settings%build_tests
model%enforce_module_names = package%build%module_naming
model%module_prefix = package%build%module_prefix
! Resolve meta-dependencies into the package and the model
call resolve_metapackages(model,package,settings,error)
if (allocated(error)) return
! Create dependencies
call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml"))
! Build and resolve model dependencies
call model%deps%add(package, error)
if (allocated(error)) return
! Update dependencies where needed
call model%deps%update(error)
if (allocated(error)) return
! build/ directory should now exist
if (.not.exists("build/.gitignore")) then
call filewrite(join_path("build", ".gitignore"),["*"])
end if
allocate(model%packages(model%deps%ndep))
has_cpp = .false.
do i = 1, model%deps%ndep
associate(dep => model%deps%dep(i))
manifest = join_path(dep%proj_dir, "fpm.toml")
call get_package_data(dependency, manifest, error, apply_defaults=.true.)
if (allocated(error)) exit
model%packages(i)%name = dependency%name
associate(features => model%packages(i)%features)
features%implicit_typing = dependency%fortran%implicit_typing
features%implicit_external = dependency%fortran%implicit_external
features%source_form = dependency%fortran%source_form
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 = [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 // &
' is not supported; will ignore it'
end if
end do
end if
if (.not.allocated(model%packages(i)%sources)) allocate(model%packages(i)%sources(0))
if (allocated(dependency%library)) then
if (allocated(dependency%library%source_dir)) then
lib_dir = join_path(dep%proj_dir, dependency%library%source_dir)
if (is_dir(lib_dir)) then
call add_sources_from_dir(model%packages(i)%sources, lib_dir, FPM_SCOPE_LIB, &
error=error)
if (allocated(error)) exit
end if
end if
if (allocated(dependency%library%include_dir)) then
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
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
! Copy naming conventions from this dependency's manifest
model%packages(i)%enforce_module_names = dependency%build%module_naming
model%packages(i)%module_prefix = dependency%build%module_prefix
end associate
end do
if (allocated(error)) return
! Add optional flags
if (has_cpp) call set_cpp_preprocessor_flags(model%compiler%id, model%fortran_compile_flags)
! Add sources from executable directories
if (is_dir('app') .and. package%build%auto_executables) then
call add_sources_from_dir(model%packages(1)%sources,'app', FPM_SCOPE_APP, &
with_executables=.true., error=error)
if (allocated(error)) then
return
end if
end if
if (is_dir('example') .and. package%build%auto_examples) then
call add_sources_from_dir(model%packages(1)%sources,'example', FPM_SCOPE_EXAMPLE, &
with_executables=.true., error=error)
if (allocated(error)) then
return
end if
end if
if (is_dir('test') .and. package%build%auto_tests) then
call add_sources_from_dir(model%packages(1)%sources,'test', FPM_SCOPE_TEST, &
with_executables=.true., error=error)
if (allocated(error)) then
return
endif
end if
if (allocated(package%executable)) then
call add_executable_sources(model%packages(1)%sources, package%executable, FPM_SCOPE_APP, &
auto_discover=package%build%auto_executables, &
error=error)
if (allocated(error)) then
return
end if
end if
if (allocated(package%example)) then
call add_executable_sources(model%packages(1)%sources, package%example, FPM_SCOPE_EXAMPLE, &
auto_discover=package%build%auto_examples, &
error=error)
if (allocated(error)) then
return
end if
end if
if (allocated(package%test)) then
call add_executable_sources(model%packages(1)%sources, package%test, FPM_SCOPE_TEST, &
auto_discover=package%build%auto_tests, &
error=error)
if (allocated(error)) then
return
endif
endif
if (settings%verbose) then
write(*,*)'<INFO> BUILD_NAME: ',model%build_prefix
write(*,*)'<INFO> COMPILER: ',model%compiler%fc
write(*,*)'<INFO> C COMPILER: ',model%compiler%cc
write(*,*)'<INFO> CXX COMPILER: ',model%compiler%cxx
write(*,*)'<INFO> COMPILER OPTIONS: ', model%fortran_compile_flags
write(*,*)'<INFO> C COMPILER OPTIONS: ', model%c_compile_flags
write(*,*)'<INFO> CXX COMPILER OPTIONS: ', model%cxx_compile_flags
write(*,*)'<INFO> LINKER OPTIONS: ', model%link_flags
write(*,*)'<INFO> INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']'
end if
! Check for invalid module names
call check_module_names(model, error)
if (allocated(error)) return
! Check for duplicate modules
duplicates_found = .false.
call check_modules_for_duplicates(model, duplicates_found)
if (duplicates_found) then
call fpm_stop(1,'*build_model*:Error: One or more duplicate module names found.')
end if
end subroutine build_model