From bfd9b06249814ad7c4bc47c0f065d6337f87076c Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:13:01 +0000 Subject: Add: backend_output to manage pretty printing of build progress --- fpm.toml | 5 +++ src/fpm_backend.f90 | 20 +++++++++- src/fpm_backend_console.f90 | 82 ++++++++++++++++++++++++++++++++++++++ src/fpm_backend_output.f90 | 97 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 203 insertions(+), 1 deletion(-) create mode 100644 src/fpm_backend_console.f90 create mode 100644 src/fpm_backend_output.f90 diff --git a/fpm.toml b/fpm.toml index 7289c82..f3a297c 100644 --- a/fpm.toml +++ b/fpm.toml @@ -14,6 +14,11 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3" git = "https://github.com/urbanjost/M_CLI2.git" rev = "ea6bbffc1c2fb0885e994d37ccf0029c99b19f24" +[dependencies.M_attr] +git = "https://github.com/urbanjost/M_attr.git" +rev = "608b9d3b40be9ff2590c23d2089781fd4da76344" + + [[test]] name = "cli-test" source-dir = "test/cli_test" diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 731763f..e0ed972 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -35,6 +35,7 @@ use fpm_model, only: fpm_model_t 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 +use fpm_backend_output implicit none private @@ -62,6 +63,8 @@ subroutine build_package(targets,model,verbose) type(string_t), allocatable :: build_dirs(:) type(string_t) :: temp + type(console_t) :: console + integer :: line, n_complete logical :: plain_output ! Need to make output directory for include (mod) files @@ -92,16 +95,24 @@ subroutine build_package(targets,model,verbose) allocate(stat(size(queue))) stat(:) = 0 build_failed = .false. + n_complete = 0 ! Set output mode plain_output = (.not.(c_isatty()==1)) .or. verbose + call console%init(plain_output) + call output_init(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) schedule(dynamic,1) + !$omp parallel do default(shared) private(skip_current,line) 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 @@ -116,10 +127,15 @@ 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 if (build_failed) then + write(*,*) '' do j=1,size(stat) if (stat(j) /= 0) then write(stderr,'(*(g0:,1x))') ' Compilation failed for object "',basename(queue(j)%ptr%output_file),'"' @@ -130,6 +146,8 @@ subroutine build_package(targets,model,verbose) end do + call output_progress_complete() + end subroutine build_package diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 new file mode 100644 index 0000000..4db0cdc --- /dev/null +++ b/src/fpm_backend_console.f90 @@ -0,0 +1,82 @@ +module fpm_backend_console +use iso_fortran_env, only: stdout=>output_unit +implicit none + +private +public :: console_t + +character(len=*), parameter :: ESC = char(27) + +type console_t + integer :: n_line = 1 + logical :: plain_mode = .false. + character(:), allocatable :: LINE_RESET + character(:), allocatable :: LINE_UP + character(:), allocatable :: LINE_DOWN +contains + procedure :: init => console_init + procedure :: write_line => console_write_line + procedure :: update_line => console_update_line +end type console_t + +contains + +subroutine console_init(console,plain_mode) + class(console_t), intent(out), target :: console + logical, intent(in), optional :: plain_mode + + if (present(plain_mode)) then + console%plain_mode = plain_mode + end if + + if (console%plain_mode) then + console%LINE_RESET = "" + console%LINE_UP = "" + console%LINE_DOWN = "" + else + console%LINE_RESET = ESC//"[2K"//ESC//"[1G" + console%LINE_UP = ESC//"[1A" + console%LINE_DOWN = ESC//"[1B" + end if + +end subroutine console_init + +function console_write_line(console,str) result(line) + class(console_t), intent(inout), target :: console + character(*), intent(in) :: str + integer :: line + + !$omp critical + line = console%n_line + + write(stdout,*) console%LINE_RESET//str + + console%n_line = console%n_line + 1 + !$omp end critical + +end function console_write_line + +subroutine console_update_line(console,line_no,str) + class(console_t), intent(in) :: console + integer, intent(in) :: line_no + character(*), intent(in) :: str + + integer :: n + + !$omp critical + + n = console%n_line - line_no !+ 1 !+ 1 + + ! Step back to line + write(stdout,'(A)',advance="no") repeat(console%LINE_UP,n)//console%LINE_RESET + + write(stdout,*) str + + ! Step forward to end + write(stdout,'(A)',advance="no") repeat(console%LINE_DOWN,n)//console%LINE_RESET + + !$omp end critical + +end subroutine console_update_line + +end module fpm_backend_console \ No newline at end of file diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 new file mode 100644 index 0000000..82c019f --- /dev/null +++ b/src/fpm_backend_output.f90 @@ -0,0 +1,97 @@ +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_backend_console, only: console_t +use M_attr, only: attr, attr_mode +implicit none + + +contains + + subroutine output_init(plain_mode) + logical, intent(in), optional :: plain_mode + + if (plain_mode) then + call attr_mode('plain') + else + call attr_mode('color') + end if + + 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 + + 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 + + write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + + line = console%write_line(trim(output_string)) + + 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 + 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)) + + !$omp critical + n_complete = n_complete + 1 + !$omp end critical + + end subroutine output_status_complete + + subroutine output_progress(n_complete, total, plain_mode) + integer, intent(in) :: n_complete, total + logical :: plain_mode + + character(:), allocatable :: advance + + if (plain_mode) then + advance = "yes" + else + advance = "no" + end if + + !$omp critical + write(*,'(A,I4,A,A)',advance=advance) '[',100*n_complete/total,'%] Compiling project...' + !$omp end critical + + end subroutine output_progress + + subroutine output_progress_complete() + + write(*,'(A)') char(27)//"[2K"//char(27)//"[1G"//attr('[100%] Project compiled successfully.') + + end subroutine output_progress_complete + +end module fpm_backend_output \ No newline at end of file -- cgit v1.2.3