Top-level routine to build package described by model
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(build_target_ptr), | intent(inout) | :: | targets(:) | |||
type(fpm_model_t), | intent(in) | :: | model | |||
logical, | intent(in) | :: | verbose |
subroutine build_package(targets,model,verbose)
type(build_target_ptr), intent(inout) :: targets(:)
type(fpm_model_t), intent(in) :: model
logical, intent(in) :: verbose
integer :: i, j
type(build_target_ptr), allocatable :: queue(:)
integer, allocatable :: schedule_ptr(:), stat(:)
logical :: build_failed, skip_current
type(string_t), allocatable :: build_dirs(:)
type(string_t) :: temp
type(build_progress_t) :: progress
logical :: plain_output
! Need to make output directory for include (mod) files
allocate(build_dirs(0))
do i = 1, size(targets)
associate(target => targets(i)%ptr)
if (target%output_dir .in. build_dirs) cycle
temp%s = target%output_dir
build_dirs = [build_dirs, temp]
end associate
end do
do i = 1, size(build_dirs)
call mkdir(build_dirs(i)%s,verbose)
end do
! Perform depth-first topological sort of targets
do i=1,size(targets)
call sort_target(targets(i)%ptr)
end do
! Construct build schedule queue
call schedule_targets(queue, schedule_ptr, targets)
! Check if queue is empty
if (.not.verbose .and. size(queue) < 1) then
write(stderr, '(a)') 'Project is up to date'
return
end if
! Initialise build status flags
allocate(stat(size(queue)))
stat(:) = 0
build_failed = .false.
! Set output mode
#ifndef FPM_BOOTSTRAP
plain_output = (.not.(c_isatty()==1)) .or. verbose
#else
plain_output = .true.
#endif
progress = build_progress_t(queue,plain_output)
! Loop over parallel schedule regions
do i=1,size(schedule_ptr)-1
! Build targets in schedule region i
!$omp parallel do default(shared) private(skip_current) schedule(dynamic,1)
do j=schedule_ptr(i),(schedule_ptr(i+1)-1)
! Check if build already failed
!$omp atomic read
skip_current = build_failed
if (.not.skip_current) then
call progress%compiling_status(j)
call build_target(model,queue(j)%ptr,verbose,stat(j))
call progress%completed_status(j,stat(j))
end if
! Set global flag if this target failed to build
if (stat(j) /= 0) then
!$omp atomic write
build_failed = .true.
end if
end do
! Check if this schedule region failed: exit with message if failed
if (build_failed) then
write(*,*)
do j=1,size(stat)
if (stat(j) /= 0) Then
call print_build_log(queue(j)%ptr)
end if
end do
do j=1,size(stat)
if (stat(j) /= 0) then
write(stderr,'(*(g0:,1x))') '<ERROR> Compilation failed for object "',basename(queue(j)%ptr%output_file),'"'
end if
end do
call fpm_stop(1,'stopping due to failed compilation')
end if
end do
call progress%success()
end subroutine build_package