Allocate a new target and append to target list
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(build_target_ptr), | intent(inout), | allocatable | :: | targets(:) | ||
character(len=*), | intent(in) | :: | package | |||
integer, | intent(in) | :: | type | |||
character(len=*), | intent(in) | :: | output_name | |||
type(srcfile_t), | intent(in), | optional | :: | source | ||
type(string_t), | intent(in), | optional | :: | link_libraries(:) | ||
type(fortran_features_t), | intent(in), | optional | :: | features | ||
type(string_t), | intent(in), | optional | :: | macros(:) | ||
character(len=*), | intent(in), | optional | :: | version |
subroutine add_target(targets, package, type, output_name, source, link_libraries, &
& features, macros, version)
type(build_target_ptr), allocatable, intent(inout) :: targets(:)
character(*), intent(in) :: package
integer, intent(in) :: type
character(*), intent(in) :: output_name
type(srcfile_t), intent(in), optional :: source
type(string_t), intent(in), optional :: link_libraries(:)
type(fortran_features_t), intent(in), optional :: features
type(string_t), intent(in), optional :: macros(:)
character(*), intent(in), optional :: version
integer :: i
type(build_target_t), pointer :: new_target
if (.not.allocated(targets)) allocate(targets(0))
! Check for duplicate outputs
do i=1,size(targets)
if (targets(i)%ptr%output_name == output_name) then
write(*,*) 'Error while building target list: duplicate output object "',&
output_name,'"'
if (present(source)) write(*,*) ' Source file: "',source%file_name,'"'
call fpm_stop(1,' ')
end if
end do
allocate(new_target)
new_target%target_type = type
new_target%output_name = output_name
new_target%package_name = package
if (present(source)) new_target%source = source
if (present(link_libraries)) new_target%link_libraries = link_libraries
if (present(features)) new_target%features = features
if (present(macros)) new_target%macros = macros
if (present(version)) new_target%version = version
allocate(new_target%dependencies(0))
targets = [targets, build_target_ptr(new_target)]
end subroutine add_target