aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLaurence Kedward <laurence.kedward@bristol.ac.uk>2020-12-02 14:21:39 +0000
committerGitHub <noreply@github.com>2020-12-02 14:21:39 +0000
commitaf67eaedf86b312c86b9f081a169cc6e220f0cb6 (patch)
treeeaf1fb51e60f0dc9f6dfbdc7cc83cb0ef8679e14
parent7d320295c6fe56cc767b352bd26f0466aa29ac5c (diff)
parentd57c59128ebea30ba29febdf98e739ce12880865 (diff)
downloadfpm-af67eaedf86b312c86b9f081a169cc6e220f0cb6.tar.gz
fpm-af67eaedf86b312c86b9f081a169cc6e220f0cb6.zip
Merge pull request #248 from LKedward/incremental2
Refactor backend for incremental rebuilds
-rw-r--r--fpm/src/fpm.f9019
-rw-r--r--fpm/src/fpm_backend.f90235
-rw-r--r--fpm/src/fpm_model.f9018
-rw-r--r--fpm/src/fpm_sources.f906
-rw-r--r--fpm/src/fpm_strings.f9077
-rw-r--r--fpm/src/fpm_targets.f9071
-rw-r--r--fpm/test/fpm_test/main.f902
-rw-r--r--fpm/test/fpm_test/test_backend.f90353
-rw-r--r--fpm/test/fpm_test/test_module_dependencies.f902
9 files changed, 701 insertions, 82 deletions
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90
index 5e190c8..b94d25f 100644
--- a/fpm/src/fpm.f90
+++ b/fpm/src/fpm.f90
@@ -8,10 +8,11 @@ use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists,
use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, &
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, &
FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, &
- FPM_TARGET_EXECUTABLE
+ FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE
use fpm_sources, only: add_executable_sources, add_sources_from_dir
-use fpm_targets, only: targets_from_sources, resolve_module_dependencies
+use fpm_targets, only: targets_from_sources, resolve_module_dependencies, &
+ resolve_target_linking
use fpm_manifest, only : get_package_data, package_config_t
use fpm_error, only : error_t, fatal_error
use fpm_manifest_test, only : test_config_t
@@ -240,8 +241,14 @@ subroutine build_model(model, settings, package, error)
model%link_flags = model%link_flags // " -l" // model%link_libraries(i)%s
end do
+ if (model%targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then
+ model%library_file = model%targets(1)%ptr%output_file
+ end if
+
call resolve_module_dependencies(model%targets,error)
+ call resolve_target_linking(model%targets)
+
end subroutine build_model
@@ -403,13 +410,7 @@ subroutine cmd_run(settings,test)
end if
- ! NB. To be replaced after incremental rebuild is implemented
- if (.not.settings%list .and. &
- any([(.not.exists(executables(i)%s),i=1,size(executables))])) then
-
- call build_package(model)
-
- end if
+ call build_package(model)
do i=1,size(executables)
if (settings%list) then
diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90
index 3cb95d7..d0843a3 100644
--- a/fpm/src/fpm_backend.f90
+++ b/fpm/src/fpm_backend.f90
@@ -1,113 +1,202 @@
+!> Implements the native fpm build backend
module fpm_backend
-! Implements the native fpm build backend
-
-use fpm_environment, only: run, get_os_type, OS_WINDOWS
-use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir
-use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, FPM_UNIT_MODULE, &
- FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, &
- FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, &
- FPM_SCOPE_TEST, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
+use fpm_environment, only: run
+use fpm_filesystem, only: dirname, join_path, exists, mkdir
+use fpm_model, only: fpm_model_t, build_target_t, build_target_ptr, &
+ FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
-use fpm_strings, only: split
+use fpm_strings, only: string_cat
implicit none
private
-public :: build_package
+public :: build_package, sort_target, schedule_targets
contains
-
+!> Top-level routine to build package described by `model`
subroutine build_package(model)
type(fpm_model_t), intent(inout) :: model
- integer :: i, ilib
- character(:), allocatable :: base, linking, subdir, link_flags
+ integer :: i, j
+ type(build_target_ptr), allocatable :: queue(:)
+ integer, allocatable :: schedule_ptr(:)
- if (.not.exists(model%output_directory)) then
- call mkdir(model%output_directory)
- end if
+ ! Need to make output directory for include (mod) files
if (.not.exists(join_path(model%output_directory,model%package_name))) then
call mkdir(join_path(model%output_directory,model%package_name))
end if
- if (model%targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then
- linking = " "//model%targets(1)%ptr%output_file
- else
- linking = " "
- end if
-
- linking = linking//" "//model%link_flags
-
+ ! Perform depth-first topological sort of targets
do i=1,size(model%targets)
- call build_target(model,model%targets(i)%ptr,linking)
+ call sort_target(model%targets(i)%ptr)
end do
-end subroutine build_package
+ ! Construct build schedule queue
+ call schedule_targets(queue, schedule_ptr, model%targets)
+ ! Loop over parallel schedule regions
+ do i=1,size(schedule_ptr)-1
+ ! Build targets in schedule region i
+ !$omp parallel do default(shared)
+ do j=schedule_ptr(i),(schedule_ptr(i+1)-1)
+
+ call build_target(model,queue(j)%ptr)
+
+ end do
+
+ end do
+
+end subroutine build_package
-recursive subroutine build_target(model,target,linking)
- ! Compile Fortran source, called recursively on it dependents
- !
- type(fpm_model_t), intent(in) :: model
- type(build_target_t), intent(inout) :: target
- character(:), allocatable, intent(in) :: linking
- integer :: i, j, ilib
+!> 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.
+!>
+recursive subroutine sort_target(target)
+ type(build_target_t), intent(inout), target :: target
+
+ integer :: i, j, fh, stat
type(build_target_t), pointer :: exe_obj
- character(:), allocatable :: objs, link_flags
- if (target%built) then
+ ! 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
write(*,*) '(!) Circular dependency found with: ',target%output_file
stop
else
- target%touched = .true.
+ target%touched = .true. ! Set touched flag
end if
- objs = " "
+ ! 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
- do i=1,size(target%dependencies)
+ allocate(target%digest_cached)
+ open(newunit=fh,file=target%output_file//'.digest',status='old')
+ read(fh,*,iostat=stat) target%digest_cached
+ close(fh)
- if (associated(target%dependencies(i)%ptr)) then
- call build_target(model,target%dependencies(i)%ptr,linking)
+ if (stat /= 0) then ! Cached digest is not recognized
+ deallocate(target%digest_cached)
end if
- if (target%target_type == FPM_TARGET_ARCHIVE ) then
+ end if
+
+ if (allocated(target%source)) then
- ! Construct object list for archive
- objs = objs//" "//target%dependencies(i)%ptr%output_file
+ ! 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
- else if (target%target_type == FPM_TARGET_EXECUTABLE .and. &
- target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then
+ elseif (exists(target%output_file)) then
- exe_obj => target%dependencies(i)%ptr
-
- ! Construct object list for executable
- objs = " "//exe_obj%output_file
-
- ! Include non-library object dependencies
- do j=1,size(exe_obj%dependencies)
+ ! Skip if target is not source-based and already exists
+ target%skip = .true.
- if (allocated(exe_obj%dependencies(j)%ptr%source)) then
- if (exe_obj%dependencies(j)%ptr%source%unit_scope == exe_obj%source%unit_scope) then
- objs = objs//" "//exe_obj%dependencies(j)%ptr%output_file
- end if
- end if
+ end if
- end do
+ ! 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
+
+
+!> Construct a build schedule from the sorted targets.
+!>
+!> The schedule is broken into regions, described by `schedule_ptr`,
+!> where targets in each region can be compiled in parallel.
+!>
+subroutine schedule_targets(queue, schedule_ptr, targets)
+ type(build_target_ptr), allocatable, intent(out) :: queue(:)
+ integer, allocatable :: schedule_ptr(:)
+ type(build_target_ptr), intent(in) :: targets(:)
+
+ integer :: i, j
+ integer :: n_schedule, n_sorted
+
+ n_schedule = 0 ! Number of schedule regions
+ n_sorted = 0 ! Total number of targets to build
+ do i=1,size(targets)
+
+ if (targets(i)%ptr%sorted) then
+ n_sorted = n_sorted + 1
+ end if
+ n_schedule = max(n_schedule, targets(i)%ptr%schedule)
+
+ end do
+
+ allocate(queue(n_sorted))
+ allocate(schedule_ptr(n_schedule+1))
+
+ ! Construct the target queue and schedule region pointer
+ n_sorted = 1
+ schedule_ptr(n_sorted) = 1
+ do i=1,n_schedule
+
+ do j=1,size(targets)
+
+ if (targets(j)%ptr%sorted) then
+ if (targets(j)%ptr%schedule == i) then
+
+ queue(n_sorted)%ptr => targets(j)%ptr
+ n_sorted = n_sorted + 1
+ end if
+ end if
+
+ end do
+
+ schedule_ptr(i+1) = n_sorted
+
+ end do
+
+end subroutine schedule_targets
+
+
+!> Call compile/link command for a single target.
+!>
+!> If successful, also caches the source file digest to disk.
+!>
+subroutine build_target(model,target)
+ type(fpm_model_t), intent(in) :: model
+ type(build_target_t), intent(in), target :: target
+
+ integer :: ilib, fh
+ character(:), allocatable :: link_flags
+
if (.not.exists(dirname(target%output_file))) then
call mkdir(dirname(target%output_file))
end if
@@ -119,22 +208,34 @@ recursive subroutine build_target(model,target,linking)
// " -o " // target%output_file)
case (FPM_TARGET_EXECUTABLE)
- link_flags = linking
+
+ link_flags = string_cat(target%link_objects," ")
+
+ if (allocated(model%library_file)) then
+ link_flags = link_flags//" "//model%library_file//" "//model%link_flags
+ else
+ link_flags = link_flags//" "//model%link_flags
+ end if
+
if (allocated(target%link_libraries)) then
- do ilib = 1, size(target%link_libraries)
- link_flags = link_flags // " -l" // target%link_libraries(ilib)%s
- end do
+ if (size(target%link_libraries) > 0) then
+ link_flags = link_flags // " -l" // string_cat(target%link_libraries," -l")
+ end if
end if
-
- call run("gfortran " // objs // model%fortran_compile_flags &
- //link_flags// " -o " // target%output_file)
+
+ call run("gfortran " // model%fortran_compile_flags &
+ //" "//link_flags// " -o " // target%output_file)
case (FPM_TARGET_ARCHIVE)
- call run("ar -rs " // target%output_file // objs)
+ call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," "))
end select
- target%built = .true.
+ if (allocated(target%source)) then
+ open(newunit=fh,file=target%output_file//'.digest',status='unknown')
+ write(fh,*) target%source%digest
+ close(fh)
+ end if
end subroutine build_target
diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90
index 20f174b..031af78 100644
--- a/fpm/src/fpm_model.f90
+++ b/fpm/src/fpm_model.f90
@@ -1,5 +1,6 @@
module fpm_model
! Definition and validation of the backend model
+use iso_fortran_env, only: int64
use fpm_strings, only: string_t
implicit none
@@ -53,6 +54,8 @@ type srcfile_t
! Files INCLUDEd by this source file
type(string_t), allocatable :: link_libraries(:)
! Native libraries to link against
+ integer(int64) :: digest
+ ! Current hash
end type srcfile_t
type build_target_ptr
@@ -70,9 +73,20 @@ type build_target_t
integer :: target_type = FPM_TARGET_UNKNOWN
type(string_t), allocatable :: link_libraries(:)
! Native libraries to link against
+ type(string_t), allocatable :: link_objects(:)
+ ! Objects needed to link this target
- logical :: built = .false.
logical :: touched = .false.
+ ! Flag set when first visited to check for circular dependencies
+ logical :: sorted = .false.
+ ! Flag set if build target is sorted for building
+ logical :: skip = .false.
+ ! Flag set if build target will be skipped (not built)
+
+ integer :: schedule = -1
+ ! Targets in the same schedule group are guaranteed to be independent
+ integer(int64), allocatable :: digest_cached
+ ! Previous hash
end type build_target_t
@@ -89,6 +103,8 @@ type :: fpm_model_t
! Command line flags passed to fortran for compilation
character(:), allocatable :: link_flags
! Command line flags pass for linking
+ character(:), allocatable :: library_file
+ ! Output file for library archive
character(:), allocatable :: output_directory
! Base directory for build
type(string_t), allocatable :: link_libraries(:)
diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90
index 5e42430..5e78d6e 100644
--- a/fpm/src/fpm_sources.f90
+++ b/fpm/src/fpm_sources.f90
@@ -7,7 +7,7 @@ use fpm_model, only: srcfile_t, fpm_model_t, &
FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST
use fpm_filesystem, only: basename, canon_path, dirname, join_path, read_lines, list_files
-use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.)
+use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.), fnv_1a
use fpm_manifest_executable, only: executable_config_t
implicit none
@@ -233,6 +233,8 @@ function parse_f_source(f_filename,error) result(f_source)
file_lines = read_lines(fh)
close(fh)
+ f_source%digest = fnv_1a(file_lines)
+
do pass = 1,2
n_use = 0
n_include = 0
@@ -512,6 +514,8 @@ function parse_c_source(c_filename,error) result(c_source)
file_lines = read_lines(fh)
close(fh)
+ c_source%digest = fnv_1a(file_lines)
+
do pass = 1,2
n_include = 0
file_loop: do i=1,size(file_lines)
diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90
index d1f5150..8a569cd 100644
--- a/fpm/src/fpm_strings.f90
+++ b/fpm/src/fpm_strings.f90
@@ -1,9 +1,10 @@
module fpm_strings
+use iso_fortran_env, only: int64
implicit none
private
public :: f_string, lower, split, str_ends_with, string_t
-public :: string_array_contains, operator(.in.)
+public :: string_array_contains, string_cat, operator(.in.), fnv_1a
type string_t
character(len=:), allocatable :: s
@@ -13,6 +14,11 @@ interface operator(.in.)
module procedure string_array_contains
end interface
+interface fnv_1a
+ procedure :: fnv_1a_char
+ procedure :: fnv_1a_string_t
+end interface fnv_1a
+
contains
logical function str_ends_with(s, e) result(r)
@@ -48,6 +54,46 @@ function f_string(c_string)
end function f_string
+!> Hash a character(*) string of default kind
+pure function fnv_1a_char(input, seed) result(hash)
+ character(*), intent(in) :: input
+ integer(int64), intent(in), optional :: seed
+ integer(int64) :: hash
+
+ integer :: i
+ integer(int64), parameter :: FNV_OFFSET_32 = 2166136261_int64
+ integer(int64), parameter :: FNV_PRIME_32 = 16777619_int64
+
+ if (present(seed)) then
+ hash = seed
+ else
+ hash = FNV_OFFSET_32
+ end if
+
+ do i=1,len(input)
+ hash = ieor(hash,iachar(input(i:i),int64)) * FNV_PRIME_32
+ end do
+
+end function fnv_1a_char
+
+
+!> Hash a string_t array of default kind
+pure function fnv_1a_string_t(input, seed) result(hash)
+ type(string_t), intent(in) :: input(:)
+ integer(int64), intent(in), optional :: seed
+ integer(int64) :: hash
+
+ integer :: i
+
+ hash = fnv_1a(input(1)%s,seed)
+
+ do i=2,size(input)
+ hash = fnv_1a(input(i)%s,hash)
+ end do
+
+end function fnv_1a_string_t
+
+
elemental pure function lower(str,begin,end) result (string)
! Changes a string to lowercase over specified range
! Author: John S. Urban
@@ -94,6 +140,35 @@ logical function string_array_contains(search_string,array)
end function string_array_contains
+!> Concatenate an array of type(string_t) into
+!> a single character
+function string_cat(strings,delim) result(cat)
+ type(string_t), intent(in) :: strings(:)
+ character(*), intent(in), optional :: delim
+ character(:), allocatable :: cat
+
+ integer :: i,n
+ character(:), allocatable :: delim_str
+
+ if (size(strings) < 1) then
+ cat = ''
+ return
+ end if
+
+ if (present(delim)) then
+ delim_str = delim
+ else
+ delim_str = ''
+ end if
+
+ cat = strings(1)%s
+ do i=2,size(strings)
+
+ cat = cat//delim_str//strings(i)%s
+
+ end do
+
+end function string_cat
subroutine split(input_line,array,delimiters,order,nulls)
! parse string on delimiter characters and store tokens into an allocatable array"
diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90
index c3a59fd..03996f7 100644
--- a/fpm/src/fpm_targets.f90
+++ b/fpm/src/fpm_targets.f90
@@ -13,9 +13,16 @@ subroutine targets_from_sources(model,sources)
type(srcfile_t), intent(in) :: sources(:)
integer :: i
+ character(:), allocatable :: xsuffix
type(build_target_t), pointer :: dep
logical :: with_lib
+ if (get_os_type() == OS_WINDOWS) then
+ xsuffix = '.exe'
+ else
+ xsuffix = ''
+ end if
+
with_lib = any([(sources(i)%unit_scope == FPM_SCOPE_LIB,i=1,size(sources))])
if (with_lib) call add_target(model%targets,type = FPM_TARGET_ARCHIVE,&
@@ -46,11 +53,13 @@ subroutine targets_from_sources(model,sources)
if (sources(i)%unit_scope == FPM_SCOPE_APP) then
call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,&
link_libraries = sources(i)%link_libraries, &
- output_file = join_path(model%output_directory,'app',sources(i)%exe_name))
+ output_file = join_path(model%output_directory,'app', &
+ sources(i)%exe_name//xsuffix))
else
call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,&
link_libraries = sources(i)%link_libraries, &
- output_file = join_path(model%output_directory,'test',sources(i)%exe_name))
+ output_file = join_path(model%output_directory,'test', &
+ sources(i)%exe_name//xsuffix))
end if
@@ -249,4 +258,62 @@ function find_module_dependency(targets,module_name,include_dir) result(target_p
end function find_module_dependency
+
+!> For link targets, enumerate any dependency objects required for linking
+subroutine resolve_target_linking(targets)
+ type(build_target_ptr), intent(inout), target :: targets(:)
+
+ integer :: i,j,k
+ type(string_t) :: link_object
+
+ do i=1,size(targets)
+
+ associate(target => targets(i)%ptr)
+
+ allocate(target%link_objects(0))
+
+ do j=1,size(target%dependencies)
+
+ if (target%target_type == FPM_TARGET_ARCHIVE ) then
+
+ ! Construct object list for archive
+ link_object%s = target%dependencies(j)%ptr%output_file
+ target%link_objects = [target%link_objects, link_object]
+
+ else if (target%target_type == FPM_TARGET_EXECUTABLE .and. &
+ target%dependencies(j)%ptr%target_type == FPM_TARGET_OBJECT) then
+
+ associate(exe_obj => target%dependencies(j)%ptr)
+
+ ! Construct object list for executable
+ link_object%s = exe_obj%output_file
+ target%link_objects = [target%link_objects, link_object]
+
+ ! Include non-library object dependencies
+ do k=1,size(exe_obj%dependencies)
+
+ if (allocated(exe_obj%dependencies(k)%ptr%source)) then
+ if (exe_obj%dependencies(k)%ptr%source%unit_scope == &
+ exe_obj%source%unit_scope) then
+
+ link_object%s = exe_obj%dependencies(k)%ptr%output_file
+ target%link_objects = [target%link_objects, link_object]
+
+ end if
+ end if
+
+ end do
+
+ end associate
+
+ end if
+
+ end do
+ end associate
+
+ end do
+
+end subroutine resolve_target_linking
+
+
end module fpm_targets
diff --git a/fpm/test/fpm_test/main.f90 b/fpm/test/fpm_test/main.f90
index eb08a94..1ba5c6a 100644
--- a/fpm/test/fpm_test/main.f90
+++ b/fpm/test/fpm_test/main.f90
@@ -7,6 +7,7 @@ program fpm_testing
use test_manifest, only : collect_manifest
use test_source_parsing, only : collect_source_parsing
use test_module_dependencies, only : collect_module_dependencies
+ use test_backend, only: collect_backend
use test_versioning, only : collect_versioning
implicit none
integer :: stat, is
@@ -21,6 +22,7 @@ program fpm_testing
& new_testsuite("fpm_manifest", collect_manifest), &
& new_testsuite("fpm_source_parsing", collect_source_parsing), &
& new_testsuite("fpm_module_dependencies", collect_module_dependencies), &
+ & new_testsuite("fpm_test_backend", collect_backend), &
& new_testsuite("fpm_versioning", collect_versioning) &
& ]
diff --git a/fpm/test/fpm_test/test_backend.f90 b/fpm/test/fpm_test/test_backend.f90
new file mode 100644
index 0000000..a7a3f0b
--- /dev/null
+++ b/fpm/test/fpm_test/test_backend.f90
@@ -0,0 +1,353 @@
+!> Define tests for the `fpm_backend` module (build scheduling)
+module test_backend
+ use testsuite, only : new_unittest, unittest_t, error_t, test_failed
+ use test_module_dependencies, only: operator(.in.)
+ use fpm_filesystem, only: exists, mkdir, get_temp_filename
+ use fpm_model, only: build_target_t, build_target_ptr, &
+ FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE
+ use fpm_targets, only: add_target, add_dependency
+ use fpm_backend, only: sort_target, schedule_targets
+ implicit none
+ private
+
+ public :: collect_backend
+
+contains
+
+
+ !> Collect all exported unit tests
+ subroutine collect_backend(testsuite)
+
+ !> Collection of tests
+ type(unittest_t), allocatable, intent(out) :: testsuite(:)
+
+ testsuite = [ &
+ & new_unittest("target-sort", test_target_sort), &
+ & new_unittest("target-sort-skip-all", test_target_sort_skip_all), &
+ & new_unittest("target-sort-rebuild-all", test_target_sort_rebuild_all), &
+ & new_unittest("schedule-targets", test_schedule_targets), &
+ & new_unittest("schedule-targets-empty", test_schedule_empty) &
+ ]
+
+ end subroutine collect_backend
+
+
+ !> Check scheduling of objects with dependencies
+ subroutine test_target_sort(error)
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(build_target_ptr), allocatable :: targets(:)
+
+ integer :: i
+
+ targets = new_test_package()
+
+ ! Perform depth-first topological sort of targets
+ do i=1,size(targets)
+
+ call sort_target(targets(i)%ptr)
+
+ end do
+
+ ! Check target states: all targets scheduled
+ do i=1,size(targets)
+
+ if (.not.targets(i)%ptr%touched) then
+ call test_failed(error,"Target touched flag not set")
+ return
+ end if
+
+ if (.not.targets(i)%ptr%sorted) then
+ call test_failed(error,"Target sort flag not set")
+ return
+ end if
+
+ if (targets(i)%ptr%skip) then
+ call test_failed(error,"Target skip flag set incorrectly")
+ return
+ end if
+
+ if (targets(i)%ptr%schedule < 0) then
+ call test_failed(error,"Target schedule not set")
+ return
+ end if
+
+ end do
+
+ ! Check all objects sheduled before library
+ do i=2,size(targets)
+
+ if (targets(i)%ptr%schedule >= targets(1)%ptr%schedule) then
+ call test_failed(error,"Object dependency scheduled after dependent library target")
+ return
+ end if
+
+ end do
+
+ ! Check target 4 schedule before targets 2 & 3
+ do i=2,3
+ if (targets(4)%ptr%schedule >= targets(i)%ptr%schedule) then
+ call test_failed(error,"Object dependency scheduled after dependent object target")
+ return
+ end if
+ end do
+
+ end subroutine test_target_sort
+
+
+
+ !> Check incremental rebuild for existing archive
+ !> all object sources are unmodified: all objects should be skipped
+ subroutine test_target_sort_skip_all(error)
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(build_target_ptr), allocatable :: targets(:)
+
+ integer :: fh, i
+
+ targets = new_test_package()
+
+ do i=2,size(targets)
+
+ ! Mimick unmodified sources
+ allocate(targets(i)%ptr%source)
+ targets(i)%ptr%source%digest = i
+ targets(i)%ptr%digest_cached = i
+
+ end do
+
+ ! Mimick archive already exists
+ open(newunit=fh,file=targets(1)%ptr%output_file,status="unknown")
+ close(fh)
+
+ ! Perform depth-first topological sort of targets
+ do i=1,size(targets)
+
+ call sort_target(targets(i)%ptr)
+
+ end do
+
+ ! Check target states: all targets skipped
+ do i=1,size(targets)
+
+ if (.not.targets(i)%ptr%touched) then
+ call test_failed(error,"Target touched flag not set")
+ return
+ end if
+
+ if (targets(i)%ptr%sorted) then
+ call test_failed(error,"Target sort flag set incorrectly")
+ return
+ end if
+
+ if (.not.targets(i)%ptr%skip) then
+ call test_failed(error,"Target skip flag set incorrectly")
+ return
+ end if
+
+ end do
+
+ end subroutine test_target_sort_skip_all
+
+
+ !> Check incremental rebuild for existing archive
+ !> all but lowest source modified: all objects should be rebuilt
+ subroutine test_target_sort_rebuild_all(error)
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(build_target_ptr), allocatable :: targets(:)
+
+ integer :: fh, i
+
+ targets = new_test_package()
+
+ do i=2,3
+
+ ! Mimick unmodified sources
+ allocate(targets(i)%ptr%source)
+ targets(i)%ptr%source%digest = i
+ targets(i)%ptr%digest_cached = i
+
+ end do
+
+ ! Mimick archive already exists
+ open(newunit=fh,file=targets(1)%ptr%output_file,status="unknown")
+ close(fh)
+
+ ! Perform depth-first topological sort of targets
+ do i=1,size(targets)
+
+ call sort_target(targets(i)%ptr)
+
+ end do
+
+ ! Check target states: all targets scheduled
+ do i=1,size(targets)
+
+ if (.not.targets(i)%ptr%sorted) then
+ call test_failed(error,"Target sort flag not set")
+ return
+ end if
+
+ if (targets(i)%ptr%skip) then
+ call test_failed(error,"Target skip flag set incorrectly")
+ return
+ end if
+
+ end do
+
+ end subroutine test_target_sort_rebuild_all
+
+
+ !> Check construction of target queue and schedule
+ subroutine test_schedule_targets(error)
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(build_target_ptr), allocatable :: targets(:)
+
+ integer :: i, j
+ type(build_target_ptr), allocatable :: queue(:)
+ integer, allocatable :: schedule_ptr(:)
+
+ targets = new_test_package()
+
+ ! 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 all targets enqueued
+ do i=1,size(targets)
+
+ if (.not.(targets(i)%ptr.in.queue)) then
+
+ call test_failed(error,"Target not found in build queue")
+ return
+
+ end if
+
+ end do
+
+ ! Check schedule structure
+ if (schedule_ptr(1) /= 1) then
+
+ call test_failed(error,"schedule_ptr(1) does not point to start of the queue")
+ return
+
+ end if
+
+ if (schedule_ptr(size(schedule_ptr)) /= size(queue)+1) then
+
+ call test_failed(error,"schedule_ptr(end) does not point to end of the queue")
+ return
+
+ end if
+
+ do i=1,size(schedule_ptr)-1
+
+ do j=schedule_ptr(i),(schedule_ptr(i+1)-1)
+
+ if (queue(j)%ptr%schedule /= i) then
+
+ call test_failed(error,"Target scheduled in the wrong region")
+ return
+
+ end if
+
+ end do
+
+ end do
+
+ end subroutine test_schedule_targets
+
+
+ !> Check construction of target queue and schedule
+ !> when there's nothing to do (all targets skipped)
+ subroutine test_schedule_empty(error)
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(build_target_ptr), allocatable :: targets(:)
+
+ integer :: i
+ type(build_target_ptr), allocatable :: queue(:)
+ integer, allocatable :: schedule_ptr(:)
+
+ targets = new_test_package()
+
+ do i=1,size(targets)
+
+ targets(i)%ptr%skip = .true.
+
+ 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 queue is empty
+ if (size(queue) > 0) then
+
+ call test_failed(error,"Expecting an empty build queue, but not empty")
+ return
+
+ end if
+
+ ! Check schedule loop is not entered
+ do i=1,size(schedule_ptr)-1
+
+ call test_failed(error,"Attempted to run an empty schedule")
+ return
+
+ end do
+
+ end subroutine test_schedule_empty
+
+
+ !> Helper to generate target objects with dependencies
+ function new_test_package() result(targets)
+
+ type(build_target_ptr), allocatable :: targets(:)
+
+ call add_target(targets,FPM_TARGET_ARCHIVE,get_temp_filename())
+
+ call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename())
+
+ call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename())
+
+ call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename())
+
+ ! Library depends on all objects
+ call add_dependency(targets(1)%ptr,targets(2)%ptr)
+ call add_dependency(targets(1)%ptr,targets(3)%ptr)
+ call add_dependency(targets(1)%ptr,targets(4)%ptr)
+
+ ! Inter-object dependency
+ ! targets 2 & 3 depend on target 4
+ call add_dependency(targets(2)%ptr,targets(4)%ptr)
+ call add_dependency(targets(3)%ptr,targets(4)%ptr)
+
+ end function new_test_package
+
+
+end module test_backend \ No newline at end of file
diff --git a/fpm/test/fpm_test/test_module_dependencies.f90 b/fpm/test/fpm_test/test_module_dependencies.f90
index c73db30..18929ac 100644
--- a/fpm/test/fpm_test/test_module_dependencies.f90
+++ b/fpm/test/fpm_test/test_module_dependencies.f90
@@ -12,7 +12,7 @@ module test_module_dependencies
implicit none
private
- public :: collect_module_dependencies
+ public :: collect_module_dependencies, operator(.in.)
interface operator(.in.)
module procedure target_in