Loading...
Searching...
No Matches
logging.f90
Go to the documentation of this file.
1!> @file
2!! @defgroup group_logging Logging
3!! Global logging, ANSI-colored diagnostics, and pretty error/warning reporting for fpx
4!!
5!! This module is the central place for all human-readable output in the fpx preprocessor.
6!! It provides:
7!! - Full ANSI color and style support (bold, underline, colors, etc.)
8!! - Structured diagnostic messages with source context, line numbers, and caret markers
9!! - Pretty-printed multi-line error/warning/help/note/info reports
10!! - Label-based highlighting of specific code ranges (like rustc-style diagnostics)
11!! - Recursive sub-diagnostic support for nested explanations
12!!
13!! Designed to produce modern, readable, IDE-friendly output similar to rustc, clang, or cargo.
14!! When `nocolor = .true.` (or terminal does not support ANSI), falls back to plain text.
15!!
16!! <h2 class="groupheader">Examples</h2>
17!!
18!! 1. Simple colored message (used internally for verbose logging):
19!! @code{.f90}
20!! use fpx_logging
21!!
22!! verbose = .true.
23!! print '(A)', render('Macro expanded: PI = 3.14159')
24!! @endcode
25!!
26!! 2. Full diagnostic report (like a compiler error):
27!! @code{.f90}
28!! character(*), parameter :: input = &
29!! '# This is a TOML document.' // nl // &
30!! 'title = "TOML Example"' // nl // &
31!! '[owner]' // nl // &
32!! 'name = "Tom Preston-Werner"' // nl // &
33!! 'dob = 1979-05-27T07:32:00-08:00 # First class dates' // nl // &
34!! '[database]' // nl // &
35!! 'server = "192.168.1.1"' // nl // &
36!! 'ports = [ 8001, 8001, 8002 ]' // nl // &
37!! 'connection_max = 5000' // nl // &
38!! 'enabled = true' // nl // &
39!! '[servers]' // nl // &
40!! ' # Indentation (tabs and/or spaces) is allowed but not required' // nl // &
41!! ' [servers.alpha]' // nl // &
42!! ' ip = "10.0.0.1"' // nl // &
43!! ' dc = "eqdc10"' // nl // &
44!! ' [servers.beta]' // nl // &
45!! ' ip = "10.0.0.2"' // nl // &
46!! ' dc = "eqdc10"' // nl // &
47!! '[title]' // nl // &
48!! 'data = [ ["gamma", "delta"], [1, 2] ]' // nl // &
49!! '# Line breaks are OK when inside arrays' // nl // &
50!! 'hosts = [' // nl // &
51!! ' "alpha",' // nl // &
52!! ' "omega"' // nl // &
53!! ']'
54!!
55!! print '(A)', render(diagnostic_report(level_error, &
56!! message="duplicated key 'title' found", &
57!! source="example.toml", &
58!! label=[label_type("table 'title' redefined here", 19, 2, 5, .true.), &
59!! label_type("first defined here", 2, 1, 5)]), &
60!! input)
61!! end
62!! @endcode
63!!
64!! Output might look like (colored in terminal):
65!! @code
66!! error: duplicated key 'title' found
67!! --> example.toml:19:2-6
68!! |
69!! 1 | # This is a TOML document.
70!! 2 | title = "TOML Example"
71!! | ----- first defined here
72!! 3 | [owner]
73!! :
74!! 18 | dc = "eqdc10"
75!! 19 | [title]
76!! | ^^^^^ table 'title' redefined here
77!! 20 | data = [ ["gamma", "delta"], [1, 2] ]
78!! |
79!! @endcode
80!!
81!! @par ANSI style & color reference (used internally)
82!! - Styles: BOLD_ON, UNDERLINE_ON, INVERSE_ON, STRIKETHROUGH_ON, ...
83!! - Foreground: RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE, ...
84!! - Background: same as foreground but prefixed with BG_
85!!
86!! @note This code is adapted from [pretty-diagnostics](https://github.com/awvwgk/pretty-diagnostics).
87module fpx_logging
88 use iso_c_binding
89
90 implicit none; private
91
92 public :: render, &
93 printf, &
95 label_type, &
96 level_error, &
97 level_warning, &
98 level_help, &
99 level_note, &
100 level_info
101
102 !> @brief Master switch for verbose diagnostic output
103 !! Default value is `.false.` (quiet mode).
104 !! Set to `.true.` to get detailed step-by-step information about
105 !! preprocessing actions. Safe to modify at any time � the change takes
106 !! effect immediately for all subsequent operations.
107 !! @ingroup group_logging
108 logical, public :: verbose
109
110 !> @brief Switch for controling the ANSI color output
111 !! Default value is `.true.` (color mode on).
112 !! Set to `.false.` to get raw string output.
113 !! @ingroup group_logging
114 logical, public :: nocolor = .false.
115
116 character(1), parameter :: nl = new_line('a') !< New line character.
117 character(1), parameter :: escape = achar(27) !< '\' character.
118 character(2), parameter :: code_start = escape//'[' !< Start ansi code, "\‍[".
119 character(1), parameter :: code_end = 'm' !< End ansi code, "m".
120 character(4), parameter :: code_clear = code_start//'0'//code_end !< Clear all styles, "\‍[0m".
121
122 character(17), parameter :: styles(1:2, 1:16) = reshape([ &
123 'BOLD_ON ', '1 ', & ! Bold on.
124 'ITALICS_ON ', '3 ', & ! Italics on.
125 'UNDERLINE_ON ', '4 ', & ! Underline on.
126 'INVERSE_ON ', '7 ', & ! Inverse on: reverse foreground and background colors.
127 'STRIKETHROUGH_ON ', '9 ', & ! Strikethrough on.
128 'BOLD_OFF ', '22 ', & ! Bold off.
129 'ITALICS_OFF ', '23 ', & ! Italics off.
130 'UNDERLINE_OFF ', '24 ', & ! Underline off.
131 'INVERSE_OFF ', '27 ', & ! Inverse off: reverse foreground and background colors.
132 'STRIKETHROUGH_OFF', '29 ', & ! Strikethrough off.
133 'FRAMED_ON ', '51 ', & ! Framed on.
134 'ENCIRCLED_ON ', '52 ', & ! Encircled on.
135 'OVERLINED_ON ', '53 ', & ! Overlined on.
136 'FRAMED_OFF ', '54 ', & ! Framed off.
137 'ENCIRCLED_OFF ', '54 ', & ! Encircled off.
138 'OVERLINED_OFF ', '55 ' & ! Overlined off.
139 ], [2, 16]) !< Styles.
140
141 character(15), parameter :: colors_fg(1:2, 1:17) = reshape([ &
142 'BLACK ', '30 ', & ! Black.
143 'RED ', '31 ', & ! Red.
144 'GREEN ', '32 ', & ! Green.
145 'YELLOW ', '33 ', & ! Yellow.
146 'BLUE ', '34 ', & ! Blue.
147 'MAGENTA ', '35 ', & ! Magenta.
148 'CYAN ', '36 ', & ! Cyan.
149 'WHITE ', '37 ', & ! White.
150 'DEFAULT ', '39 ', & ! Default (white).
151 'BLACK_INTENSE ', '90 ', & ! Black intense.
152 'RED_INTENSE ', '91 ', & ! Red intense.
153 'GREEN_INTENSE ', '92 ', & ! Green intense.
154 'YELLOW_INTENSE ', '93 ', & ! Yellow intense.
155 'BLUE_INTENSE ', '94 ', & ! Blue intense.
156 'MAGENTA_INTENSE', '95 ', & ! Magenta intense.
157 'CYAN_INTENSE ', '96 ', & ! Cyan intense.
158 'WHITE_INTENSE ', '97 ' & ! White intense.
159 ], [2, 17]) !< Foreground colors.
160
161 character(15), parameter :: colors_bg(1:2, 1:17) = reshape([ &
162 'BLACK ', '40 ', & ! Black.
163 'RED ', '41 ', & ! Red.
164 'GREEN ', '42 ', & ! Green.
165 'YELLOW ', '43 ', & ! Yellow.
166 'BLUE ', '44 ', & ! Blue.
167 'MAGENTA ', '45 ', & ! Magenta.
168 'CYAN ', '46 ', & ! Cyan.
169 'WHITE ', '47 ', & ! White.
170 'DEFAULT ', '49 ', & ! Default (black).
171 'BLACK_INTENSE ', '100 ', & ! Black intense.
172 'RED_INTENSE ', '101 ', & ! Red intense.
173 'GREEN_INTENSE ', '102 ', & ! Green intense.
174 'YELLOW_INTENSE ', '103 ', & ! Yellow intense.
175 'BLUE_INTENSE ', '104 ', & ! Blue intense.
176 'MAGENTA_INTENSE', '105 ', & ! Magenta intense.
177 'CYAN_INTENSE ', '106 ', & ! Cyan intense.
178 'WHITE_INTENSE ', '107 ' & ! White intense.
179 ], [2, 17]) !< Background colors.
180
181 !> Interface to render diagnostic messages and labels
182 !!
183 !! @b Remarks
184 !! @ingroup group_logging
185 interface render
186 module procedure :: render_diagnostic
187 module procedure :: render_text
188 module procedure :: render_text_with_label
189 module procedure :: render_text_with_labels
190 end interface
191
192 enum, bind(c)
193 enumerator :: LEVEL_ERROR = 0
194 enumerator :: LEVEL_WARNING = 1
195 enumerator :: LEVEL_HELP = 2
196 enumerator :: LEVEL_NOTE = 3
197 enumerator :: LEVEL_INFO = 4
198 end enum
199
200 !> Represents text as a sequence of ASCII code units.
201 !! The derived type wraps an allocatable character array.
202 !!
203 !! <h2 class="groupheader">Examples</h2>
204 !! @code{.f90}
205 !! type(string) :: s
206 !! s = 'foo'
207 !! @endcode
208 !!
209 !! <h2 class="groupheader">Constructors</h2>
210 !! Initializes a new instance of the label_type class
211 !! <h3>label_type(character(*), integer, integer, (optional) integer)</h3>
212 !! @verbatim type(string) function string(character(*) text, integer first, integer length, (optional) integer level) @endverbatim
213 !!
214 !! @param[in] text Text displayed next to the label
215 !! @param[in] first Position of the label
216 !! @param[in] length Length of the label
217 !! @param[in] level (optional) Level of the label
218 !!
219 !! @b Examples
220 !! @code{.f90}
221 !! type(label_type) :: label
222 !! label = label_type('Syntax error', 5, 7)
223 !! @endcode
224 !! @return The constructed label_type object.
225 !!
226 !! <h3>label_type(integer, character(*), integer, integer, (optional) integer, (optional) logical)</h3>
227 !! @verbatim type(string) function label_type(integer line, character(*) text, integer first, integer length, (optional) integer level, (optional) logical primary) @endverbatim
228 !!
229 !! @param[in] line line number for the label
230 !! @param[in] text Text displayed next to the label
231 !! @param[in] first Position of the label
232 !! @param[in] length Length of the label
233 !! @param[in] level (optional) Level of the label
234 !! @param[in] primary .true. if the label is the primary one
235 !!
236 !! @b Examples
237 !! @code{.f90}
238 !! type(label_type) :: label
239 !! label = label_type(1, 'Syntax error', 5, 7, LEVEL_ERROR, .true.)
240 !! @endcode
241 !! @return The constructed label_type object.
242 !!
243 !! <h2 class="groupheader">Remarks</h2>
244 !!
245 !! @ingroup group_logging
247 !> Level of message
248 integer, allocatable :: level
249 !> Primary message
250 logical :: primary
251 !> Line number of message
252 integer :: line
253 !> First character of message
254 integer :: first
255 !> Last character of message
256 integer :: last
257 !> Message text
258 character(:), allocatable :: text
259 !> Identifier of context
260 character(:), allocatable :: source
261 end type
262
263 interface label_type
264 module procedure :: label_new
265 module procedure :: label_new_with_line
266 end interface
267
268 !> Definition of diagnostic message
270 !> Level of message
271 integer :: level
272 !> Primary message
273 character(:), allocatable :: message
274 !> Context of the diagnostic source
275 character(:), allocatable :: source
276 !> Messages associated with this diagnostic
277 type(label_type), allocatable :: label(:)
278 !> Additional diagnostic information
279 type(diagnostic_report), allocatable :: sub(:)
280 end type
281
282 interface diagnostic_report
283 module procedure diagnostic_new
284 end interface
285
286 !! @private
288 integer :: first, last
289 end type
290
291contains
292
293 !> Colorize and stylize strings, DEFAULT kind.
294 !! @param[in] string Input string.
295 !! @param[in] foreground Foreground color definition.
296 !! @param[in] background Background color definition.
297 !! @param[in] style Style definition.
298 pure function colorize(string, foreground, background, style) result(res)
299 character(*), intent(in) :: string
300 character(*), intent(in), optional :: foreground
301 character(*), intent(in), optional :: background
302 character(*), intent(in), optional :: style
303 character(:), allocatable :: res
304 !private
305 integer :: i
306
307 res = string
308 if (nocolor) return
309 if (present(foreground)) then
310 i = color_index(upper(foreground))
311 if (i > 0) res = code_start//trim(colors_fg(2, i))//code_end//res//code_clear
312 end if
313 if (present(background)) then
314 i = color_index(upper(background))
315 if (i > 0) res = code_start//trim(colors_bg(2, i))//code_end//res//code_clear
316 end if
317 if (present(style)) then
318 i = style_index(upper(style))
319 if (i > 0) res = code_start//trim(styles(2, i))//code_end//res//code_clear
320 end if
321 end function
322
323 !> Return the array-index corresponding to the queried color.
324 !! @note Because Foreground and backround colors lists share the same name,
325 !! no matter what array is used to find the color index.
326 !! Thus, the foreground array is used.
327 elemental integer function color_index(color) result(res)
328 character(*), intent(in) :: color !< Color definition.
329 !private
330 integer :: i
331
332 res = 0
333 do i = 1, size(colors_fg, dim=2)
334 if (trim(colors_fg(1, i)) == trim(adjustl(color))) then
335 res = i
336 exit
337 end if
338 end do
339 end function
340
341 !> Return the array-index corresponding to the queried style.
342 elemental integer function style_index(style) result(res)
343 character(*), intent(in) :: style !< Style definition.
344 !private
345 integer :: i
346
347 res = 0
348 do i = 1, size(styles, dim = 2)
349 if (trim(styles(1, i)) == trim(adjustl(style))) then
350 res = i
351 exit
352 end if
353 end do
354 end function
355
356 !> Return a string with all uppercase characters.
357 elemental function upper(string)
358 character(*), intent(in) :: string !< Input string.
359 character(len(string)) :: upper !< Upper case string.
360 !private
361 integer, parameter :: a = iachar('a'), z = iachar('z'), case_diff = iachar('a')-iachar('A')
362 integer :: i, ichar
363
364 do i = 1, len(string)
365 ichar = iachar(string(i:i))
366 if (ichar >= a .and. ichar <= z) ichar = ichar - case_diff
367 upper(i:i) = achar(ichar)
368 enddo
369 end function
370
371 type(label_type) pure function label_new(text, first, length, level) result(that)
372 character(*), intent(in) :: text
373 integer, intent(in) :: first
374 integer, intent(in) :: length
375 integer, intent(in) , optional :: level
376
377 that%text = text
378 that%line = 1
379 that%first = max(1, first)
380 that%last = that%first + length
381 that%primary = .true.
382 if (present(level)) that%level = level
383 end function
384
385 type(label_type) pure function label_new_with_line(line, text, first, length, primary, level) result(that)
386 integer, intent(in) :: line
387 character(*), intent(in) :: text
388 integer, intent(in) :: first
389 integer, intent(in) :: length
390 logical, intent(in), optional :: primary
391 integer, intent(in) , optional :: level
392
393 that%text = text
394 that%line = line
395 that%first = max(1, first)
396 that%last = that%first + length
397 if (present(primary)) then
398 that%primary = primary
399 else
400 that%primary = .true.
401 end if
402 if (present(level)) that%level = level
403 end function
404
405 !> Create new diagnostic message
406 !! @param[in] level Level of message
407 !! @param[in] message Primary message
408 !! @param[in] source Context of the diagnostic source
409 !! @param[in] label Messages associated with this diagnostic
410 !! @param[in] diagnostic Additional diagnostic information
411 type(diagnostic_report) function diagnostic_new(level, message, source, label, diagnostic) result(that)
412 integer, intent(in) :: level
413 character(*), intent(in), optional :: message
414 character(*), intent(in), optional :: source
415 type(label_type), intent(in), optional :: label(..)
416 type(diagnostic_report), intent(in), optional :: diagnostic(:)
417 !private
418 integer :: i
419
420 that%level = level
421 if (present(message)) that%message = message
422 if (present(source)) that%source = source
423 if (present(label)) then
424 if (allocated(that%label)) deallocate(that%label)
425 select rank(label)
426 rank(0)
427 allocate(that%label(1))
428 that%label(1) = label
429 if (.not. allocated(that%label(1)%level)) that%label(1)%level = level
430 rank(1)
431 allocate(that%label, source = label)
432 do i = 1, size(label)
433 if (.not. allocated(that%label(i)%level)) that%label(i)%level = level
434 end do
435 end select
436 end if
437 if (present(diagnostic)) that%sub = diagnostic
438
439 if (allocated(that%label)) then
440 if (.not. any(that%label(:)%primary)) then
441 that%label(1)%primary = .true.
442 end if
443 end if
444 end function
445
446 pure function line_tokens(input) result(res)
447 character(*), intent(in) :: input
448 type(line_token), allocatable :: res(:)
449 !private
450 integer :: first, last
451
452 first = 1
453 last = 0
454 allocate(res(0))
455 do while (first <= len(input))
456 last = index(input(first + 1:), nl) + first - 1
457 if (last < first) then
458 last = len(input)
459 end if
460
461 res = [res, line_token(first, last)]
462
463 first = last + (1 + len(nl))
464 end do
465 end function
466
467 pure recursive function render_diagnostic(diag, input, linemum) result(res)
468 type(diagnostic_report), intent(in) :: diag
469 character(*), intent(in) :: input
470 integer, intent(in), optional :: linemum
471 character(:), allocatable :: res
472 !private
473 integer :: i
474
475 res = render_message(diag%level, diag%message)
476
477 if (allocated(diag%label)) then
478 res = res // nl // render_text_with_labels(input, diag%label, source=diag%source, linemum=linemum)
479 else
480 res = res // nl // render_text_with_labels(input, [label_type('', 1, len_trim(input))], source=diag%source, linemum=linemum)
481 end if
482
483 if (allocated(diag%sub)) then
484 do i = 1, size(diag%sub)
485 res = res // nl // render_diagnostic(diag%sub(i), input, linemum)
486 end do
487 end if
488 end function
489
490 pure function render_message(level, message) result(res)
491 integer, intent(in) :: level
492 character(*), intent(in), optional :: message
493 character(:), allocatable :: res
494
495 if (present(message)) then
496 res = level_name(level) // colorize(': ' // message, style = 'bold_on')
497 else
498 res = level_name(level)
499 end if
500 end function
501
502 pure function level_name(level) result(res)
503 integer, intent(in) :: level
504 character(:), allocatable :: res
505
506 select case (level)
507 case (level_error)
508 res = colorize('error', foreground = 'red', style = 'bold_on')
509 case (level_warning)
510 res = colorize('warning', foreground = 'yellow', style = 'bold_on')
511 case (level_help)
512 res = colorize('help', foreground = 'cyan', style = 'bold_on')
513 case (level_note)
514 res = colorize('note', foreground = 'blue', style = 'bold_on')
515 case (level_info)
516 res = colorize('info', foreground = 'magenta', style = 'bold_on')
517 case default
518 res = colorize('unknown', foreground = 'blue', style = 'bold_on')
519 end select
520 end function
521
522 pure function render_source(source, offset) result(res)
523 character(*), intent(in) :: source
524 integer, intent(in) :: offset
525 character(:), allocatable :: res
526
527 res = repeat(' ', offset) // colorize('-->', foreground = 'blue') // ' ' // source
528 end function
529
530 pure function render_text(input, source, linenum) result(res)
531 character(*), intent(in) :: input
532 character(*), intent(in), optional :: source
533 integer, intent(in), optional :: linenum
534 character(:), allocatable :: res
535 !private
536 integer :: i, offset, iline
537 type(line_token), allocatable :: token(:)
538
539 iline = 1; if (present(linenum)) iline = linenum
540 token = line_tokens(input)
541 offset = integer_width(iline)
542
543 if (present(source)) then
544 res = render_source(source, offset) // nl // &
545 repeat(' ', offset + 1) // colorize('|', foreground = 'blue')
546 else
547 res = repeat(' ', offset + 1) // colorize('|', foreground = 'blue')
548 end if
549
550 do i = 1, size(token)
551 res = res // nl // render_line(input(token(i)%first:token(i)%last), to_string(iline + i - 1, offset))
552 end do
553 res = res // nl // repeat(' ', offset + 1) // colorize('|', foreground = 'blue')
554 end function
555
556 pure function render_text_with_label(input, label, source, linenum) result(res)
557 character(*), intent(in) :: input
558 type(label_type), intent(in) :: label
559 character(*), intent(in), optional :: source
560 integer, intent(in), optional :: linenum
561 character(:), allocatable :: res
562
563 res = render_text_with_labels(input, [label], source, linenum)
564 end function
565
566 pure function render_text_with_labels(input, labels, source, linemum) result(res)
567 character(*), intent(in) :: input
568 type(label_type), intent(in) :: labels(:)
569 character(*), intent(in), optional :: source
570 integer, intent(in), optional :: linemum
571 character(:), allocatable :: res
572 !private
573 integer :: i, j, offset, first, last, iline
574 type(line_token), allocatable :: token(:)
575 logical, allocatable :: display(:)
576
577 token = line_tokens(input)
578 first = max(1, minval(labels%line) - 1)
579 last = min(size(token), maxval(labels%line) + 1)
580 iline = 1; if (present(linemum)) iline = linemum
581 offset = integer_width(iline)
582
583 i = 1 ! Without a primary we use the first label
584 do j = 1, size(labels)
585 if (labels(j)%primary) then
586 i = j
587 exit
588 end if
589 end do
590
591 if (present(source)) then
592 res = render_source(source, offset) // ':' // &
593 to_string(labels(i)%line) // ':' // &
594 to_string(labels(i)%first) // '-' // to_string(labels(i)%last) // nl // &
595 repeat(' ', offset + 1) // colorize('|', foreground = 'blue')
596 else
597 res = repeat(' ', offset + 1) // colorize('|', foreground = 'blue')
598 end if
599
600 allocate(display(first:last), source=.false.)
601 do j = 1, size(labels)
602 display(max(first, labels(j)%line - 1):min(last, labels(j)%line + 1)) = .true.
603 end do
604
605 do i = first, last
606 if (.not. display(i)) then
607 if (display(i - 1)) then
608 res = res // nl //&
609 repeat(' ', offset + 1) // colorize(':', foreground = 'blue')
610 end if
611 cycle
612 end if
613
614 res = res // nl //&
615 & render_line(input(token(i)%first:token(i)%last), &
616 & to_string(iline + i - 1, offset))
617 if (any(i == labels%line)) then
618 do j = 1, size(labels)
619 if (labels(j)%line /= i) cycle
620 res = res // nl //&
621 & repeat(' ', offset + 1) // colorize('|', foreground = 'blue') // &
622 & render_label(labels(j))
623 end do
624 end if
625 end do
626 res = res // nl // repeat(' ', offset + 1) // colorize('|', foreground = 'blue')
627 end function
628
629 pure function render_label(label) result(res)
630 type(label_type), intent(in) :: label
631 character(:), allocatable :: res
632 !private
633 integer :: width
634 character(1) :: marker
635 character(:), allocatable :: this_color
636
637 marker = merge('^', '-', label%primary)
638 width = label%last - label%first
639
640 if (allocated(label%level)) then
641 select case (label%level)
642 case (level_error)
643 res = repeat(' ', label%first) // colorize(repeat(marker, width), foreground = 'red')
644 if (allocated(label%text)) then
645 res = res // ' ' // colorize(label%text, foreground = 'red')
646 end if
647 case (level_warning)
648 res = repeat(' ', label%first) // colorize(repeat(marker, width), foreground = 'yellow')
649 if (allocated(label%text)) then
650 res = res // ' ' // colorize(label%text, foreground = 'yellow')
651 end if
652 case (level_help)
653 res = repeat(' ', label%first) // colorize(repeat(marker, width), foreground = 'cyan')
654 if (allocated(label%text)) then
655 res = res // ' ' // colorize(label%text, foreground = 'cyan')
656 end if
657 case (level_info)
658 res = repeat(' ', label%first) // colorize(repeat(marker, width), foreground = 'magenta')
659 if (allocated(label%text)) then
660 res = res // ' ' // colorize(label%text, foreground = 'magenta')
661 end if
662 case default
663 res = repeat(' ', label%first) // colorize(repeat(marker, width), foreground = 'blue')
664 if (allocated(label%text)) then
665 res = res // ' ' // colorize(label%text, foreground = 'blue')
666 end if
667 end select
668 else
669 res = repeat(' ', label%first) // repeat(marker, width)
670 if (allocated(label%text)) then
671 res = res // ' ' // colorize(label%text, foreground = 'blue')
672 end if
673 end if
674 end function
675
676 pure function render_line(input, line) result(res)
677 character(*), intent(in) :: input
678 character(*), intent(in) :: line
679 character(:), allocatable :: res
680
681 res = line // ' ' // colorize('|', foreground = 'blue') // ' ' // input
682 end function
683
684 pure integer function integer_width(input) result(res)
685 integer, value :: input
686
687 res = 0
688 do while (input /= 0)
689 input = input / 10
690 res = res + 1
691 end do
692
693 end function
694
695 !> Represent an integer as character sequence.
696 pure function to_string(val, width) result(res)
697 integer, intent(in) :: val
698 integer, intent(in), optional :: width
699 character(:), allocatable :: res
700 !private
701 integer, parameter :: buffer_len = range(val) + 2
702 character(buffer_len) :: buffer
703 integer :: n, pos
704 character(1), parameter :: numbers(0:9) = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']
705
706 if (val == 0) then
707 res = numbers(0)
708 return
709 end if
710
711 n = abs(val)
712 buffer = ''
713
714 pos = buffer_len + 1
715 do while (n > 0)
716 pos = pos - 1
717 buffer(pos:pos) = numbers(mod(n, 10))
718 n = n / 10
719 end do
720 if (val < 0) then
721 pos = pos - 1
722 buffer(pos:pos) = '-'
723 end if
724
725 if (present(width)) then
726 res = repeat(' ', max(width - (buffer_len + 1 - pos), 0)) // buffer(pos:)
727 else
728 res = buffer(pos:)
729 end if
730 end function
731
732 !> Conditional pritn of the error/warning message.
733 !! @param[in] str Input string.
734 !! @param[in] fmt (optional) print format.
735 subroutine printf(str, fmt)
736 character(*), intent(in) :: str
737 character(*), intent(in), optional :: fmt
738
739 if (verbose) then
740 if (present(fmt)) then
741 print fmt, str
742 else
743 print '(A)', str
744 end if
745 end if
746 end subroutine
747
748end module
logical, public nocolor
Switch for controling the ANSI color output Default value is .true. (color mode on)....
Definition logging.f90:114
logical, public verbose
Master switch for verbose diagnostic output Default value is .false. (quiet mode)....
Definition logging.f90:108
Interface to render diagnostic messages and labels.
Definition logging.f90:185
Definition of diagnostic message.
Definition logging.f90:269
Represents text as a sequence of ASCII code units. The derived type wraps an allocatable character ar...
Definition logging.f90:246