!># Build backend !> Uses a list of `[[build_target_ptr]]` and a valid `[[fpm_model]]` instance !> to schedule and execute the compilation and linking of package targets. !> !> The package build process (`[[build_package]]`) comprises three steps: !> !> 1. __Target sorting:__ topological sort of the target dependency graph (`[[sort_target]]`) !> 2. __Target scheduling:__ group targets into schedule regions based on the sorting (`[[schedule_targets]]`) !> 3. __Target building:__ generate targets by compilation or linking !> !> @note If compiled with OpenMP, targets will be build in parallel where possible. !> !>### Incremental compilation !> The backend process supports *incremental* compilation whereby targets are not !> re-compiled if their corresponding dependencies have not been modified. !> !> Targets (objects, executables and libraries) are not re-compiled if the target output !> file already exists AND its inputs are unmodified since it was last generated AND all of !> the target dependencies are not marked for re-compilation !> !> The inputs of a target are summarised by a digest (hash) of its source file, if any, !> and of the digests of its dependencies. Source file digests are calculated during !> the source parsing phase ([[fpm_source_parsing]]); target digests are cached to disk after !> a target is successfully generated. !> module fpm_backend use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_error, only : fpm_stop, error_t use fpm_environment, only: has_openmp, build_threads use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, run, getline use fpm_model, only: fpm_model_t use fpm_compiler, only: drop_compile_options use fpm_strings, only: string_t, operator(.in.) use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, & FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE, & FPM_TARGET_CPP_OBJECT, FPM_TARGET_SHARED use fpm_backend_output use fpm_compile_commands, only: compile_command_table_t implicit none private public :: build_package, sort_target, schedule_targets #ifndef FPM_BOOTSTRAP interface function c_isatty() bind(C, name = 'c_isatty') use, intrinsic :: iso_c_binding, only: c_int integer(c_int) :: c_isatty end function end interface #endif contains !> Top-level routine to build package described by `model` subroutine build_package(targets,model,verbose,dry_run,jobs) type(build_target_ptr), intent(inout) :: targets(:) type(fpm_model_t), intent(in) :: model logical, intent(in) :: verbose !> If dry_run, the build process is only mocked, but the list of compile_commands !> is still created logical, intent(in) :: dry_run !> Number of targets to build at once (--jobs): 0 or absent uses the OpenMP default integer, intent(in), optional :: jobs integer :: i, j, n_jobs, n_threads 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(error_t), allocatable :: error 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) if (.not.dry_run) 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, dry_run) 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 .and. .not.dry_run) then write(stderr, '(a)') 'Project is up to date' return end if ! Initialise build status flags allocate(stat(size(queue)),source=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,model%build_dir) ! Number of threads that build targets n_jobs = 0 if (present(jobs)) n_jobs = jobs if (n_jobs > 1 .and. .not.has_openmp() .and. .not.dry_run) then write(stderr,'(a,i0,a)') '<WARNING> --jobs ',n_jobs,' ignored: this fpm was built without OpenMP,'// & ' so it builds one target at a time' end if n_threads = build_threads(n_jobs) ! Loop over parallel schedule regions do i=1,size(schedule_ptr)-1 ! Build targets in schedule region i. gfortran keeps the length of a deferred-length ! character function result in a static variable that all threads share: code run ! from this loop takes such results under critical (fpm_string_result) !$omp parallel do default(shared) private(skip_current) schedule(dynamic,1) num_threads(n_threads) 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 if (.not.dry_run) call progress%compiling_status(j) call build_target(model,queue(j)%ptr,verbose,dry_run, & progress%compile_commands,stat(j)) if (.not.dry_run) 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 if (.not.dry_run) call progress%success() call progress%dump_commands(error) if (allocated(error)) call fpm_stop(1,'error writing compile_commands.json: '//trim(error%message)) end subroutine build_package !> Topologically sort a target for scheduling by !> recursing over its dependencies. !> !> Checks disk-cached target digests to determine if targets are !> up-to-date. Up-to-date targets 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 !> recursive subroutine sort_target(target, mock) type(build_target_t), intent(inout), target :: target !> Optionally sort ALL targets if this is a dry run logical, optional, intent(in) :: mock integer :: i, fh, stat logical :: dry_run dry_run = .false. if (present(mock)) dry_run = mock ! Check if target has already been processed (as a dependency) if (target%sorted .or. target%skip) return ! 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 target digest if present if (.not.allocated(target%digest_cached) .and. & exists(target%output_file) .and. & exists(target%output_file//'.digest') .and. & (.not.dry_run)) then allocate(target%digest_cached) open(newunit=fh,file=target%output_file//'.digest',status='old') read(fh,*,iostat=stat) target%digest_cached close(fh) ! Cached digest is not recognized if (stat /= 0) deallocate(target%digest_cached) end if ! Sort dependencies first: the target digest depends on theirs do i=1,size(target%dependencies) call sort_target(target%dependencies(i)%ptr, dry_run) end do ! Skip if target was last built from the same inputs: its source file, if any, ! and the digests of its dependencies. These catch a dependency rebuilt by an ! earlier run that did not rebuild this target (it stopped early, or did not ! include it, as `fpm build` does with tests) target%digest = target%compute_digest() target%skip = .false. if (allocated(target%digest_cached) .and. .not.dry_run) then target%skip = target%digest_cached == target%digest end if ! Loop over target dependencies target%schedule = 1 do i=1,size(target%dependencies) 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 target digest to disk. !> subroutine build_target(model,target,verbose,dry_run,table,stat) type(fpm_model_t), intent(in) :: model type(build_target_t), intent(in), target :: target logical, intent(in) :: verbose !> If dry_run, the build process is only mocked, but compile_commands are still created logical, intent(in) :: dry_run type(compile_command_table_t), intent(inout) :: table integer, intent(out) :: stat integer :: fh character(len=:), allocatable :: link_flags ! Check and create the output directory under one lock, so two threads never ! both create it: on Windows, mkdir fails if the directory already exists !$omp critical (output_dir) if (.not.exists(dirname(target%output_file)) .and. .not.dry_run) then call mkdir(dirname(target%output_file),verbose) end if !$omp end critical (output_dir) select case(target%target_type) case (FPM_TARGET_OBJECT) call model%compiler%compile_fortran(target%source%file_name, target%output_file, & & target%compile_flags, target%output_log_file, stat, table, dry_run) case (FPM_TARGET_C_OBJECT) call model%compiler%compile_c(target%source%file_name, target%output_file, & & target%compile_flags, target%output_log_file, stat, table, dry_run) case (FPM_TARGET_CPP_OBJECT) call model%compiler%compile_cpp(target%source%file_name, target%output_file, & & target%compile_flags, target%output_log_file, stat, table, dry_run) case (FPM_TARGET_EXECUTABLE) ! Executables link in parallel: see run_argv !$omp critical (fpm_string_result) link_flags = target%compile_flags//drop_compile_options(target%link_flags, target%compile_flags) !$omp end critical (fpm_string_result) call model%compiler%link(target%output_file, link_flags, target%output_log_file, stat, dry_run) case (FPM_TARGET_ARCHIVE) call model%archiver%make_archive(target%output_file, target%link_objects, & & target%output_log_file, stat, dry_run) case (FPM_TARGET_SHARED) call model%compiler%link_shared(target%output_file, target%link_flags, & & target%output_log_file, stat, dry_run) end select if (stat == 0 .and. .not.dry_run) then open(newunit=fh,file=target%output_file//'.digest',status='unknown') write(fh,*) target%digest close(fh) end if end subroutine build_target !> Read and print the build log for target !> subroutine print_build_log(target) type(build_target_t), intent(in), target :: target integer :: fh, ios character(:), allocatable :: line if (exists(target%output_log_file)) then open(newunit=fh,file=target%output_log_file,status='old') do call getline(fh, line, ios) if (ios /= 0) exit write(*,'(A)') trim(line) end do close(fh) else write(stderr,'(*(g0:,1x))') '<ERROR> Unable to find build log "',basename(target%output_log_file),'"' end if end subroutine print_build_log end module fpm_backend