1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
!># Build Backend Progress Output
!> This module provides a derived type `build_progress_t` for printing build status
!> and progress messages to the console while the backend is building the package.
!>
!> The `build_progress_t` type supports two modes: `normal` and `plain`
!> where the former does 'pretty' output and the latter does not.
!> The `normal` mode is intended for typical interactive usage whereas
!> 'plain' mode is used with the `--verbose` flag or when `stdout` is not attached
!> to a terminal (e.g. when piping or redirecting `stdout`). In these cases,
!> the pretty output must be suppressed to avoid control codes being output.
module fpm_backend_output
use iso_fortran_env, only: stdout=>output_unit
use fpm_filesystem, only: basename
use fpm_targets, only: build_target_ptr
use fpm_backend_console, only: console_t, LINE_RESET, COLOR_RED, COLOR_GREEN, COLOR_YELLOW, COLOR_RESET
implicit none
private
public build_progress_t
!> Build progress object
type build_progress_t
!> Console object for updating console lines
type(console_t) :: console
!> Number of completed targets
integer :: n_complete
!> Total number of targets scheduled
integer :: n_target
!> 'Plain' output (no colors or updating)
logical :: plain_mode = .true.
!> Store needed when updating previous console lines
integer, allocatable :: output_lines(:)
!> Queue of scheduled build targets
type(build_target_ptr), pointer :: target_queue(:)
contains
!> Output 'compiling' status for build target
procedure :: compiling_status => output_status_compiling
!> Output 'complete' status for build target
procedure :: completed_status => output_status_complete
!> Output finished status for whole package
procedure :: success => output_progress_success
end type build_progress_t
!> Constructor for build_progress_t
interface build_progress_t
procedure :: new_build_progress
end interface build_progress_t
contains
!> Initialise a new build progress object
function new_build_progress(target_queue,plain_mode) result(progress)
!> The queue of scheduled targets
type(build_target_ptr), intent(in), target :: target_queue(:)
!> Enable 'plain' output for progress object
logical, intent(in), optional :: plain_mode
!> Progress object to initialise
type(build_progress_t) :: progress
progress%n_target = size(target_queue,1)
progress%target_queue => target_queue
progress%plain_mode = plain_mode
progress%n_complete = 0
allocate(progress%output_lines(progress%n_target))
end function new_build_progress
!> Output 'compiling' status for build target and overall percentage progress
subroutine output_status_compiling(progress, queue_index)
!> Progress object
class(build_progress_t), intent(inout) :: progress
!> Index of build target in the target queue
integer, intent(in) :: queue_index
character(:), allocatable :: target_name
character(100) :: output_string
character(100) :: overall_progress
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 ! Plain output
!$omp critical
write(*,'(A8,A30)') trim(overall_progress),target_name
!$omp end critical
else ! Pretty output
write(output_string,'(A,T40,A,A)') target_name, COLOR_YELLOW//'compiling...'//COLOR_RESET
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
!> Output 'complete' status for build target and update overall percentage progress
subroutine output_status_complete(progress, queue_index, build_stat)
!> Progress object
class(build_progress_t), intent(inout) :: progress
!> Index of build target in the target queue
integer, intent(in) :: queue_index
!> Build status flag
integer, intent(in) :: build_stat
character(:), allocatable :: target_name
character(100) :: output_string
character(100) :: overall_progress
!$omp critical
progress%n_complete = progress%n_complete + 1
!$omp end critical
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
if (build_stat == 0) then
write(output_string,'(A,T40,A,A)') target_name,COLOR_GREEN//'done.'//COLOR_RESET
else
write(output_string,'(A,T40,A,A)') target_name,COLOR_RED//'failed.'//COLOR_RESET
end if
write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] '
if (progress%plain_mode) then ! Plain output
!$omp critical
write(*,'(A8,A30,A7)') trim(overall_progress),target_name, 'done.'
!$omp end critical
else ! Pretty output
call progress%console%update_line(progress%output_lines(queue_index),trim(output_string))
call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.)
end if
end associate
end subroutine output_status_complete
!> Output finished status for whole package
subroutine output_progress_success(progress)
class(build_progress_t), intent(inout) :: progress
if (progress%plain_mode) then ! Plain output
write(*,'(A)') '[100%] Project compiled successfully.'
else ! Pretty output
write(*,'(A)') LINE_RESET//COLOR_GREEN//'[100%] Project compiled successfully.'//COLOR_RESET
end if
end subroutine output_progress_success
end module fpm_backend_output
|
