diff options
| -rw-r--r-- | fpm/src/fpm.f90 | 7 | ||||
| -rw-r--r-- | fpm/src/fpm_backend.f90 | 176 | ||||
| -rw-r--r-- | fpm/src/fpm_model.f90 | 12 | ||||
| -rw-r--r-- | fpm/src/fpm_strings.f90 | 28 | ||||
| -rw-r--r-- | fpm/src/fpm_targets.f90 | 58 |
5 files changed, 183 insertions, 98 deletions
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index c822571..9c9e5db 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, FPM_TARGET_ARCHIVE +use fpm_targets, only: targets_from_sources, resolve_module_dependencies, & + resolve_target_linking use fpm_manifest, only : get_package_data, default_executable, & default_library, package_t, default_test use fpm_error, only : error_t, fatal_error @@ -247,6 +248,8 @@ subroutine build_model(model, settings, package, error) call resolve_module_dependencies(model%targets,error) + call resolve_target_linking(model%targets) + end subroutine build_model !> Apply package defaults diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 08ea899..9e45c86 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -1,50 +1,49 @@ +!> 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, build_target_ptr, & - 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, j type(build_target_ptr), allocatable :: queue(:) - integer, allocatable :: region_ptr(:) + 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 + ! Perform depth-first topological sort of targets do i=1,size(model%targets) - call schedule_target(model%targets(i)%ptr) + call sort_target(model%targets(i)%ptr) end do - call get_build_queue(queue, region_ptr, model%targets) + ! Construct build schedule queue + call schedule_targets(queue, schedule_ptr, model%targets) - do i=1,size(region_ptr)-1 + ! 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=region_ptr(i),(region_ptr(i+1)-1) + do j=schedule_ptr(i),(schedule_ptr(i+1)-1) call build_target(model,queue(j)%ptr) @@ -52,35 +51,37 @@ subroutine build_package(model) !$OMP END PARALLEL DO end do - end subroutine build_package - -recursive subroutine schedule_target(target) - ! - ! +!> Topologically sort a target for scheduling by +!> recursing over it's 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 - if (target%scheduled .or. target%skip) then + ! Check if target has already been processed (as a dependency) + if (target%sorted .or. target%skip) then return end if - if (.not.exists(dirname(target%output_file))) then - call mkdir(dirname(target%output_file)) - 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 + ! 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 @@ -90,113 +91,106 @@ recursive subroutine schedule_target(target) read(fh,*,iostat=stat) target%digest_cached close(fh) - if (stat /= 0) then - write(*,*) 'Internal error: unable to read cached source hash' - write(*,*) target%output_file//'.digest',' stat = ', stat - error stop + 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 - target%link_objects = " " - target%region = 1 + ! Loop over target dependencies + target%schedule = 1 do i=1,size(target%dependencies) - call schedule_target(target%dependencies(i)%ptr) + ! 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. - target%region = max(target%region,target%dependencies(i)%ptr%region+1) - end if - - if (target%target_type == FPM_TARGET_ARCHIVE ) then - - ! Construct object list for archive - target%link_objects = target%link_objects//" "//target%dependencies(i)%ptr%output_file - - else if (target%target_type == FPM_TARGET_EXECUTABLE .and. & - target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then - - exe_obj => target%dependencies(i)%ptr - - ! Construct object list for executable - target%link_objects = " "//exe_obj%output_file - - ! Include non-library object dependencies - do j=1,size(exe_obj%dependencies) - - if (allocated(exe_obj%dependencies(j)%ptr%source)) then - if (exe_obj%dependencies(j)%ptr%source%unit_scope == exe_obj%source%unit_scope) then - target%link_objects = target%link_objects//" "//exe_obj%dependencies(j)%ptr%output_file - end if - end if - - end do + ! Set target schedule after all of its dependencies + target%schedule = max(target%schedule,target%dependencies(i)%ptr%schedule+1) end if end do - target%scheduled = .not.target%skip + ! Mark flag as processed: either sorted or skipped + target%sorted = .not.target%skip -end subroutine schedule_target +end subroutine sort_target -subroutine get_build_queue(queue, region_ptr, targets) +!> 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 :: region_ptr(:) + integer, allocatable :: schedule_ptr(:) type(build_target_ptr), intent(in) :: targets(:) integer :: i, j - integer :: nRegion, n_scheduled + integer :: n_schedule, n_sorted - nRegion = 0 - n_scheduled = 0 + 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%scheduled) then - n_scheduled = n_scheduled + 1 + if (targets(i)%ptr%sorted) then + n_sorted = n_sorted + 1 end if - nRegion = max(nRegion, targets(i)%ptr%region) + n_schedule = max(n_schedule, targets(i)%ptr%schedule) end do - allocate(queue(n_scheduled)) - allocate(region_ptr(nRegion+1)) + allocate(queue(n_sorted)) + allocate(schedule_ptr(n_schedule+1)) - n_scheduled = 1 - region_ptr(n_scheduled) = 1 - do i=1,nRegion + ! 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%scheduled) then - if (targets(j)%ptr%region == i) then + if (targets(j)%ptr%sorted) then + if (targets(j)%ptr%schedule == i) then - queue(n_scheduled)%ptr => targets(j)%ptr - n_scheduled = n_scheduled + 1 + queue(n_sorted)%ptr => targets(j)%ptr + n_sorted = n_sorted + 1 end if end if end do - region_ptr(i+1) = n_scheduled + schedule_ptr(i+1) = n_sorted end do -end subroutine get_build_queue +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 @@ -204,6 +198,10 @@ subroutine build_target(model,target) integer :: ilib, fh character(:), allocatable :: link_flags + if (.not.exists(dirname(target%output_file))) then + call mkdir(dirname(target%output_file)) + end if + select case(target%target_type) case (FPM_TARGET_OBJECT) @@ -218,16 +216,16 @@ subroutine build_target(model,target) 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 " // target%link_objects // model%fortran_compile_flags & + call run("gfortran " // string_cat(target%link_objects," ") // model%fortran_compile_flags & //link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) - call run("ar -rs " // target%output_file // target%link_objects) + call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," ")) end select diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 3a879ad..e38f58a 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -73,18 +73,18 @@ type build_target_t integer :: target_type = FPM_TARGET_UNKNOWN type(string_t), allocatable :: link_libraries(:) ! Native libraries to link against - - character(:), allocatable :: link_objects + type(string_t), allocatable :: link_objects(:) ! Objects needed to link this target + logical :: touched = .false. ! Flag set when first visited to check for circular dependencies - logical :: scheduled = .false. - ! Flag set if build target is scheduled for building + 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 :: region - ! Targets in the same region are guaranteed independent + integer :: schedule + ! Targets in the same schedule group are guaranteed to be independent integer(int64), allocatable :: digest_cached ! Previous hash diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 3c64a08..2d1cb72 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -4,7 +4,7 @@ implicit none private public :: f_string, lower, split, str_ends_with, string_t -public :: string_array_contains, operator(.in.), fnv_1a +public :: string_array_contains, string_cat, operator(.in.), fnv_1a type string_t character(len=:), allocatable :: s @@ -140,6 +140,32 @@ 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) return + + 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 364e9d8..03996f7 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -258,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 |