subroutine cmd_run(settings,test)
class(fpm_run_settings), intent(inout) :: settings
logical, intent(in) :: test
integer :: i, j, col_width
logical :: found(size(settings%name))
type(error_t), allocatable :: error
type(package_config_t) :: package
type(fpm_model_t) :: model
type(build_target_ptr), allocatable :: targets(:)
type(string_t) :: exe_cmd
type(string_t), allocatable :: executables(:)
type(build_target_t), pointer :: exe_target
type(srcfile_t), pointer :: exe_source
integer :: run_scope,firsterror
integer, allocatable :: stat(:),target_ID(:)
character(len=:),allocatable :: line
call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
if (allocated(error)) then
call fpm_stop(1, '*cmd_run* Package error: '//error%message)
end if
call build_model(model, settings, package, error)
if (allocated(error)) then
call fpm_stop(1, '*cmd_run* Model error: '//error%message)
end if
call targets_from_sources(targets, model, settings%prune, error)
if (allocated(error)) then
call fpm_stop(1, '*cmd_run* Targets error: '//error%message)
end if
if (test) then
run_scope = FPM_SCOPE_TEST
else
run_scope = merge(FPM_SCOPE_EXAMPLE, FPM_SCOPE_APP, settings%example)
end if
! Enumerate executable targets to run
col_width = -1
found(:) = .false.
allocate(executables(size(targets)),target_ID(size(targets)))
enumerate: do i=1,size(targets)
exe_target => targets(i)%ptr
if (should_be_run(settings,run_scope,exe_target)) then
exe_source => exe_target%dependencies(1)%ptr%source
col_width = max(col_width,len(basename(exe_target%output_file))+2)
! Priority by name ID, or 0 if no name present (run first)
j = settings%name_ID(exe_source%exe_name)
target_ID(i) = j
if (j>0) found(j) = .true.
exe_cmd%s = exe_target%output_file
executables(i) = exe_cmd
else
target_ID(i) = huge(target_ID(i))
endif
end do enumerate
! sort executables by ascending name ID, resize
call sort_executables(target_ID,executables)
! Check if any apps/tests were found
if (col_width < 0) then
if (test) then
call fpm_stop(0,'No tests to run')
else
call fpm_stop(0,'No executables to run')
end if
end if
! Check all names are valid
! or no name and found more than one file
if ( any(.not.found) ) then
line=join(settings%name)
if(line/='.')then ! do not report these special strings
if(any(.not.found))then
write(stderr,'(A)',advance="no")'<ERROR>*cmd_run*:specified names '
do j=1,size(settings%name)
if (.not.found(j)) write(stderr,'(A)',advance="no") '"'//trim(settings%name(j))//'" '
end do
write(stderr,'(A)') 'not found.'
write(stderr,*)
else if(settings%verbose)then
write(stderr,'(A)',advance="yes")'<INFO>when more than one executable is available'
write(stderr,'(A)',advance="yes")' program names must be specified.'
endif
endif
call compact_list_all()
if(line=='.' .or. line==' ')then ! do not report these special strings
call fpm_stop(0,'')
else
call fpm_stop(1,'')
endif
end if
call build_package(targets,model,verbose=settings%verbose)
if (settings%list) then
call compact_list()
else
allocate(stat(size(executables)))
do i=1,size(executables)
if (exists(executables(i)%s)) then
if(settings%runner /= ' ')then
if(.not.allocated(settings%args))then
call run(settings%runner_command()//' '//executables(i)%s, &
echo=settings%verbose, exitstat=stat(i))
else
call run(settings%runner_command()//' '//executables(i)%s//" "//settings%args, &
echo=settings%verbose, exitstat=stat(i))
endif
else
if(.not.allocated(settings%args))then
call run(executables(i)%s,echo=settings%verbose, exitstat=stat(i))
else
call run(executables(i)%s//" "//settings%args,echo=settings%verbose, &
exitstat=stat(i))
endif
endif
else
call fpm_stop(1,'*cmd_run*:'//executables(i)%s//' not found')
end if
end do
if (any(stat /= 0)) then
do i=1,size(stat)
if (stat(i) /= 0) then
write(stderr,'(*(g0:,1x))') '<ERROR> Execution for object "',basename(executables(i)%s),&
'" returned exit code ',stat(i)
end if
end do
firsterror = findloc(stat/=0,value=.true.,dim=1)
call fpm_stop(stat(firsterror),'*cmd_run*:stopping due to failed executions')
end if
end if
contains
subroutine compact_list_all()
integer, parameter :: LINE_WIDTH = 80
integer :: ii, jj, nCol
jj = 1
nCol = LINE_WIDTH/col_width
write(stderr,*) 'Available names:'
do ii=1,size(targets)
exe_target => targets(ii)%ptr
if (exe_target%target_type == FPM_TARGET_EXECUTABLE .and. &
allocated(exe_target%dependencies)) then
exe_source => exe_target%dependencies(1)%ptr%source
if (exe_source%unit_scope == run_scope) then
write(stderr,'(A)',advance=(merge("yes","no ",modulo(jj,nCol)==0))) &
& [character(len=col_width) :: basename(exe_target%output_file, suffix=.false.)]
jj = jj + 1
end if
end if
end do
write(stderr,*)
end subroutine compact_list_all
subroutine compact_list()
integer, parameter :: LINE_WIDTH = 80
integer :: ii, jj, nCol
jj = 1
nCol = LINE_WIDTH/col_width
write(stderr,*) 'Matched names:'
do ii=1,size(executables)
write(stderr,'(A)',advance=(merge("yes","no ",modulo(jj,nCol)==0))) &
& [character(len=col_width) :: basename(executables(ii)%s, suffix=.false.)]
jj = jj + 1
end do
write(stderr,*)
end subroutine compact_list
end subroutine cmd_run