Topologically sort a target for scheduling by recursing over its dependencies.
Checks disk-cached source hashes to determine if objects are up-to-date. Up-to-date sources are tagged as skipped.
On completion, target
should either be marked as
sorted (target%sorted=.true.
) or skipped (target%skip=.true.
)
If target
is marked as sorted, target%schedule
should be an
integer greater than zero indicating the region for scheduling
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(build_target_t), | intent(inout), | target | :: | target |
recursive subroutine sort_target(target)
type(build_target_t), intent(inout), target :: target
integer :: i, fh, stat
! Check if target has already been processed (as a dependency)
if (target%sorted .or. target%skip) then
return
end if
! Check for a circular dependency
! (If target has been touched but not processed)
if (target%touched) then
call fpm_stop(1,'(!) Circular dependency found with: '//target%output_file)
else
target%touched = .true. ! Set touched flag
end if
! Load cached source file digest if present
if (.not.allocated(target%digest_cached) .and. &
exists(target%output_file) .and. &
exists(target%output_file//'.digest')) then
allocate(target%digest_cached)
open(newunit=fh,file=target%output_file//'.digest',status='old')
read(fh,*,iostat=stat) target%digest_cached
close(fh)
if (stat /= 0) then ! Cached digest is not recognized
deallocate(target%digest_cached)
end if
end if
if (allocated(target%source)) then
! Skip if target is source-based and source file is unmodified
if (allocated(target%digest_cached)) then
if (target%digest_cached == target%source%digest) target%skip = .true.
end if
elseif (exists(target%output_file)) then
! Skip if target is not source-based and already exists
target%skip = .true.
end if
! Loop over target dependencies
target%schedule = 1
do i=1,size(target%dependencies)
! Sort dependency
call sort_target(target%dependencies(i)%ptr)
if (.not.target%dependencies(i)%ptr%skip) then
! Can't skip target if any dependency is not skipped
target%skip = .false.
! Set target schedule after all of its dependencies
target%schedule = max(target%schedule,target%dependencies(i)%ptr%schedule+1)
end if
end do
! Mark flag as processed: either sorted or skipped
target%sorted = .not.target%skip
end subroutine sort_target