aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLaurence Kedward <laurence.kedward@bristol.ac.uk>2021-11-22 16:13:01 +0000
committerLaurence Kedward <laurence.kedward@bristol.ac.uk>2021-11-23 10:07:56 +0000
commitbfd9b06249814ad7c4bc47c0f065d6337f87076c (patch)
tree1b1a857fa0017397b7432f7e2860baf315aeb590 /src
parent995fb2e834e4e555e8b6bc32eadb57983ef5b298 (diff)
downloadfpm-bfd9b06249814ad7c4bc47c0f065d6337f87076c.tar.gz
fpm-bfd9b06249814ad7c4bc47c0f065d6337f87076c.zip
Add: backend_output to manage pretty printing of build progress
Diffstat (limited to 'src')
-rw-r--r--src/fpm_backend.f9020
-rw-r--r--src/fpm_backend_console.f9082
-rw-r--r--src/fpm_backend_output.f9097
3 files changed, 198 insertions, 1 deletions
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))') '<ERROR> 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('<yellow>compiling...</yellow>')
+
+ 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('<green>done.</green>')
+ else
+ write(output_string,'(A,T40,A,A)') target_name,attr('<red>failed.</red>')
+ 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('<green>[100%] Project compiled successfully.</green>')
+
+ end subroutine output_progress_complete
+
+end module fpm_backend_output \ No newline at end of file