targets_from_sources Subroutine

public subroutine targets_from_sources(targets, model, prune, library, error)

High-level wrapper to generate build target information

Arguments

Type IntentOptional Attributes Name
type(build_target_ptr), intent(out), allocatable :: targets(:)

The generated list of build targets

type(fpm_model_t), intent(inout), target :: model

The package model from which to construct the target list

logical, intent(in) :: prune

Enable tree-shaking/pruning of module dependencies

type(library_config_t), intent(in), optional :: library

Library build configuration

type(error_t), intent(out), allocatable :: error

Error structure


Source Code

subroutine targets_from_sources(targets,model,prune,library,error)

    !> The generated list of build targets
    type(build_target_ptr), intent(out), allocatable :: targets(:)

    !> The package model from which to construct the target list
    type(fpm_model_t), intent(inout), target :: model
    
    !> Library build configuration
    type(library_config_t), intent(in), optional :: library

    !> Enable tree-shaking/pruning of module dependencies
    logical, intent(in) :: prune

    !> Error structure
    type(error_t), intent(out), allocatable :: error
    
    logical :: should_prune

    call build_target_list(targets,model,library)

    call collect_exe_link_dependencies(targets)

    call resolve_module_dependencies(targets,model%external_modules,error)
    if (allocated(error)) return

    ! Prune unused source files, unless we're building shared libraries that need 
    ! all sources to be distributable
    should_prune = prune
    if (present(library)) should_prune = should_prune .and. library%monolithic()
        
    call prune_build_targets(targets,model%packages(1),should_prune)

    call resolve_target_linking(targets,model,library,error)
    if (allocated(error)) return

end subroutine targets_from_sources