Add to sources
by looking for source files in directory
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(srcfile_t), | intent(inout), | allocatable, target | :: | sources(:) |
List of |
|
character(len=*), | intent(in) | :: | directory |
Directory in which to search for source files |
||
integer, | intent(in) | :: | scope |
Scope to apply to the discovered sources, see fpm_model for enumeration |
||
logical, | intent(in), | optional | :: | with_executables |
Executable sources (fortran |
|
logical, | intent(in), | optional | :: | recurse |
Whether to recursively search subdirectories, default is |
|
type(error_t), | intent(out), | allocatable | :: | error |
Error handling |
subroutine add_sources_from_dir(sources,directory,scope,with_executables,recurse,error)
!> List of `[[srcfile_t]]` objects to append to. Allocated if not allocated
type(srcfile_t), allocatable, intent(inout), target :: sources(:)
!> Directory in which to search for source files
character(*), intent(in) :: directory
!> Scope to apply to the discovered sources, see [[fpm_model]] for enumeration
integer, intent(in) :: scope
!> Executable sources (fortran `program`s) are ignored unless `with_executables=.true.`
logical, intent(in), optional :: with_executables
!> Whether to recursively search subdirectories, default is `.true.`
logical, intent(in), optional :: recurse
!> Error handling
type(error_t), allocatable, intent(out) :: error
integer :: i
logical, allocatable :: is_source(:), exclude_source(:)
logical :: recurse_
type(string_t), allocatable :: file_names(:)
type(string_t), allocatable :: src_file_names(:)
type(string_t), allocatable :: existing_src_files(:)
type(srcfile_t), allocatable :: dir_sources(:)
recurse_ = .true.
if (present(recurse)) recurse_ = recurse
! Scan directory for sources
call list_files(directory, file_names,recurse=recurse_)
if (allocated(sources)) then
allocate(existing_src_files(size(sources)))
do i=1,size(sources)
existing_src_files(i)%s = canon_path(sources(i)%file_name)
end do
else
allocate(existing_src_files(0))
end if
is_source = [(.not.(is_hidden_file(basename(file_names(i)%s))) .and. &
.not.(canon_path(file_names(i)%s) .in. existing_src_files) .and. &
(str_ends_with(lower(file_names(i)%s), fortran_suffixes) .or. &
str_ends_with(lower(file_names(i)%s), c_suffixes) ),i=1,size(file_names))]
src_file_names = pack(file_names,is_source)
allocate(dir_sources(size(src_file_names)))
allocate(exclude_source(size(src_file_names)))
do i = 1, size(src_file_names)
dir_sources(i) = parse_source(src_file_names(i)%s,error)
if (allocated(error)) return
dir_sources(i)%unit_scope = scope
allocate(dir_sources(i)%link_libraries(0))
! Exclude executables unless specified otherwise
exclude_source(i) = (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM)
if (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM .and. &
& present(with_executables)) then
if (with_executables) then
exclude_source(i) = .false.
end if
end if
end do
if (.not.allocated(sources)) then
sources = pack(dir_sources,.not.exclude_source)
else
sources = [sources, pack(dir_sources,.not.exclude_source)]
end if
end subroutine add_sources_from_dir