Add to sources
using the executable and test entries in the manifest and
applies any executable-specific overrides such as executable%name
.
Adds all sources (including modules) from each executable%source_dir
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(srcfile_t), | intent(inout), | allocatable, target | :: | sources(:) |
List of |
|
class(executable_config_t), | intent(in) | :: | executables(:) |
List of |
||
integer, | intent(in) | :: | scope |
Scope to apply to the discovered sources: either |
||
logical, | intent(in) | :: | auto_discover |
If |
||
type(error_t), | intent(out), | allocatable | :: | error |
Error handling |
subroutine add_executable_sources(sources,executables,scope,auto_discover,error)
!> List of `[[srcfile_t]]` objects to append to. Allocated if not allocated
type(srcfile_t), allocatable, intent(inout), target :: sources(:)
!> List of `[[executable_config_t]]` entries from manifest
class(executable_config_t), intent(in) :: executables(:)
!> Scope to apply to the discovered sources: either `FPM_SCOPE_APP` or `FPM_SCOPE_TEST`, see [[fpm_model]]
integer, intent(in) :: scope
!> If `.false.` only executables and tests specified in the manifest are added to `sources`
logical, intent(in) :: auto_discover
!> Error handling
type(error_t), allocatable, intent(out) :: error
integer :: i, j
type(string_t), allocatable :: exe_dirs(:)
type(srcfile_t) :: exe_source
call get_executable_source_dirs(exe_dirs,executables)
do i=1,size(exe_dirs)
call add_sources_from_dir(sources,exe_dirs(i)%s, scope, &
with_executables=auto_discover, recurse=.false., error=error)
if (allocated(error)) then
return
end if
end do
exe_loop: do i=1,size(executables)
! Check if executable already discovered automatically
! and apply any overrides
do j=1,size(sources)
if (basename(sources(j)%file_name,suffix=.true.) == executables(i)%main .and.&
canon_path(dirname(sources(j)%file_name)) == &
canon_path(executables(i)%source_dir) ) then
sources(j)%exe_name = executables(i)%name
if (allocated(executables(i)%link)) then
sources(j)%link_libraries = executables(i)%link
end if
sources(j)%unit_type = FPM_UNIT_PROGRAM
cycle exe_loop
end if
end do
! Add if not already discovered (auto_discovery off)
associate(exe => executables(i))
exe_source = parse_source(join_path(exe%source_dir,exe%main),error)
exe_source%exe_name = exe%name
if (allocated(exe%link)) then
exe_source%link_libraries = exe%link
end if
exe_source%unit_type = FPM_UNIT_PROGRAM
exe_source%unit_scope = scope
end associate
if (allocated(error)) return
if (.not.allocated(sources)) then
sources = [exe_source]
else
sources = [sources, exe_source]
end if
end do exe_loop
end subroutine add_executable_sources