From 37ba9d7cf61d6b9ddbfe59a4456311fda62ef101 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Fri, 26 Nov 2021 17:32:07 +0000 Subject: Simplify implementation and cleanup plain mode output --- src/fpm_backend.F90 | 24 +++---- src/fpm_backend_console.f90 | 28 ++++++-- src/fpm_backend_output.f90 | 157 ++++++++++++++++++++++++++++++-------------- 3 files changed, 137 insertions(+), 72 deletions(-) diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index cb2dbc0..796c7ac 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -65,8 +65,7 @@ subroutine build_package(targets,model,verbose) type(string_t), allocatable :: build_dirs(:) type(string_t) :: temp - type(console_t) :: console - integer :: line, n_complete + type(build_progress_t) :: progress logical :: plain_output ! Need to make output directory for include (mod) files @@ -97,34 +96,31 @@ subroutine build_package(targets,model,verbose) allocate(stat(size(queue))) stat(:) = 0 build_failed = .false. - n_complete = 0 ! Set output mode #ifndef FPM_BOOTSTRAP plain_output = (.not.(c_isatty()==1)) .or. verbose #else - plain_output = verbose + plain_output = .true. #endif - call console%init(plain_output) - call output_init(plain_output) + + call progress%init(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,line) schedule(dynamic,1) + !$omp parallel do default(shared) private(skip_current) schedule(dynamic,1) do j=schedule_ptr(i),(schedule_ptr(i+1)-1) - ! Update console output - call output_status_compiling(console, line, queue(j)%ptr) - call output_progress(n_complete, size(queue),plain_output) - ! 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 @@ -133,10 +129,6 @@ subroutine build_package(targets,model,verbose) build_failed = .true. end if - ! Update console output - call output_status_complete(console, line, queue(j)%ptr,stat(j), n_complete) - call output_progress(n_complete, size(queue),plain_output) - end do ! Check if this schedule region failed: exit with message if failed @@ -157,7 +149,7 @@ subroutine build_package(targets,model,verbose) end do - call output_progress_complete() + call progress%success() end subroutine build_package diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 index 4db0cdc..7daff14 100644 --- a/src/fpm_backend_console.f90 +++ b/src/fpm_backend_console.f90 @@ -41,20 +41,36 @@ subroutine console_init(console,plain_mode) end subroutine console_init -function console_write_line(console,str) result(line) +subroutine console_write_line(console,str,line,advance) class(console_t), intent(inout), target :: console character(*), intent(in) :: str - integer :: line + integer, intent(out), optional :: line + logical, intent(in), optional :: advance + + character(3) :: adv + + adv = "yes" + if (present(advance)) then + if (.not.advance) then + adv = "no" + end if + end if !$omp critical - line = console%n_line - write(stdout,*) console%LINE_RESET//str + if (present(line)) then + line = console%n_line + end if + + write(stdout,'(A)',advance=trim(adv)) console%LINE_RESET//str + + if (adv=="yes") then + console%n_line = console%n_line + 1 + end if - console%n_line = console%n_line + 1 !$omp end critical -end function console_write_line +end subroutine console_write_line subroutine console_update_line(console,line_no,str) class(console_t), intent(in) :: console diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 82c019f..4eb2889 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -1,15 +1,38 @@ module fpm_backend_output use iso_fortran_env, only: stdout=>output_unit use fpm_filesystem, only: basename -use fpm_targets, only: build_target_t +use fpm_targets, only: build_target_ptr use fpm_backend_console, only: console_t use M_attr, only: attr, attr_mode implicit none +type build_progress_t + + type(console_t) :: console + + integer :: n_complete + + integer :: n_target + + logical :: plain_mode = .true. + + integer, allocatable :: output_lines(:) + + type(build_target_ptr), pointer :: target_queue(:) + +contains + procedure :: init => output_init + procedure :: compiling_status => output_status_compiling + procedure :: completed_status => output_status_complete + procedure :: success => output_progress_success + +end type build_progress_t contains - subroutine output_init(plain_mode) + subroutine output_init(progress,target_queue,plain_mode) + class(build_progress_t), intent(out) :: progress + type(build_target_ptr), intent(in), target :: target_queue(:) logical, intent(in), optional :: plain_mode if (plain_mode) then @@ -18,80 +41,114 @@ contains call attr_mode('color') end if + call progress%console%init(plain_mode) + + progress%n_target = size(target_queue,1) + progress%target_queue => target_queue + progress%plain_mode = plain_mode + + allocate(progress%output_lines(progress%n_target)) + end subroutine output_init - subroutine output_status_compiling(console, line, target) - type(console_t), intent(inout), target :: console - integer, intent(inout) :: line - type(build_target_t), intent(in) :: target + subroutine output_status_compiling(progress, queue_index) + class(build_progress_t), intent(inout) :: progress + integer, intent(in) :: queue_index character(:), allocatable :: target_name character(100) :: output_string + character(100) :: overall_progress - if (allocated(target%source)) then - target_name = basename(target%source%file_name) - else - target_name = basename(target%output_file) - end if + associate(target=>progress%target_queue(queue_index)%ptr) + + if (allocated(target%source)) then + target_name = basename(target%source%file_name) + else + target_name = basename(target%output_file) + end if + + write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%]' + + if (progress%plain_mode) then + + !$omp critical + write(*,'(A8,A30)') trim(overall_progress),target_name + !$omp end critical - write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + else - line = console%write_line(trim(output_string)) + write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + call progress%console%write_line(trim(output_string),progress%output_lines(queue_index)) + + call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.) + + end if + + end associate end subroutine output_status_compiling - subroutine output_status_complete(console, line, target, build_stat, n_complete) - type(console_t), intent(inout), target :: console - integer, intent(in) :: line - type(build_target_t), intent(in) :: target + + subroutine output_status_complete(progress, queue_index, build_stat) + class(build_progress_t), intent(inout) :: progress + integer, intent(in) :: queue_index integer, intent(in) :: build_stat - integer, intent(inout) :: n_complete character(:), allocatable :: target_name character(100) :: output_string - - if (allocated(target%source)) then - target_name = basename(target%source%file_name) - else - target_name = basename(target%output_file) - end if - - if (build_stat == 0) then - write(output_string,'(A,T40,A,A)') target_name,attr('done.') - else - write(output_string,'(A,T40,A,A)') target_name,attr('failed.') - end if - - call console%update_line(line,trim(output_string)) + character(100) :: overall_progress !$omp critical - n_complete = n_complete + 1 + progress%n_complete = progress%n_complete + 1 !$omp end critical - end subroutine output_status_complete + associate(target=>progress%target_queue(queue_index)%ptr) - subroutine output_progress(n_complete, total, plain_mode) - integer, intent(in) :: n_complete, total - logical :: plain_mode + if (allocated(target%source)) then + target_name = basename(target%source%file_name) + else + target_name = basename(target%output_file) + end if - character(:), allocatable :: advance + if (build_stat == 0) then + write(output_string,'(A,T40,A,A)') target_name,attr('done.') + else + write(output_string,'(A,T40,A,A)') target_name,attr('failed.') + end if - if (plain_mode) then - advance = "yes" - else - advance = "no" - end if + write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] ' - !$omp critical - write(*,'(A,I4,A,A)',advance=advance) '[',100*n_complete/total,'%] Compiling project...' - !$omp end critical + if (progress%plain_mode) then + + !$omp critical + write(*,'(A8,A30,A7)') trim(overall_progress),target_name, 'done.' + !$omp end critical + + else - end subroutine output_progress + call progress%console%update_line(progress%output_lines(queue_index),trim(output_string)) - subroutine output_progress_complete() + call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.) - write(*,'(A)') char(27)//"[2K"//char(27)//"[1G"//attr('[100%] Project compiled successfully.') + end if + + end associate + + end subroutine output_status_complete + + subroutine output_progress_success(progress) + class(build_progress_t), intent(inout) :: progress + + if (progress%plain_mode) then + + write(*,'(A)') attr('[100%] Project compiled successfully.') + + else + + write(*,'(A)') progress%console%LINE_RESET//attr('[100%] Project compiled successfully.') + + end if - end subroutine output_progress_complete + end subroutine output_progress_success end module fpm_backend_output \ No newline at end of file -- cgit v1.2.3