aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLaurence Kedward <laurence.kedward@bristol.ac.uk>2021-11-26 17:32:07 +0000
committerLaurence Kedward <laurence.kedward@bristol.ac.uk>2021-11-26 17:32:07 +0000
commit37ba9d7cf61d6b9ddbfe59a4456311fda62ef101 (patch)
treebd9d618584f275a48031d67f7a4e8b41ff215c5a /src
parentab7cb42fddc3cf19fe20c76dac527a9e591b11c2 (diff)
downloadfpm-37ba9d7cf61d6b9ddbfe59a4456311fda62ef101.tar.gz
fpm-37ba9d7cf61d6b9ddbfe59a4456311fda62ef101.zip
Simplify implementation and cleanup plain mode output
Diffstat (limited to 'src')
-rw-r--r--src/fpm_backend.F9024
-rw-r--r--src/fpm_backend_console.f9028
-rw-r--r--src/fpm_backend_output.f90157
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('<yellow>compiling...</yellow>')
+ else
- line = console%write_line(trim(output_string))
+ write(output_string,'(A,T40,A,A)') target_name,attr('<yellow>compiling...</yellow>')
+ 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('<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))
+ 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('<green>done.</green>')
+ else
+ write(output_string,'(A,T40,A,A)') target_name,attr('<red>failed.</red>')
+ 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('<green>[100%] Project compiled successfully.</green>')
+ 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('<green>[100%] Project compiled successfully.</green>')
+
+ else
+
+ write(*,'(A)') progress%console%LINE_RESET//attr('<green>[100%] Project compiled successfully.</green>')
+
+ end if
- end subroutine output_progress_complete
+ end subroutine output_progress_success
end module fpm_backend_output \ No newline at end of file