print_error Subroutine

private impure subroutine print_error(this)

Type Bound

debug

Arguments

Type IntentOptional Attributes Name
class(debug), intent(in) :: this

Source Code

   impure subroutine print_error(this)
      class(debug), intent(in) :: this
      character(len=1) :: sev_letter
      character(len=*), parameter :: &
         ESC   = char(27), &
         RED   = ESC//"[31m", &
         YEL   = ESC//"[33m", &
         BLU   = ESC//"[34m", &
         GRY   = ESC//"[90m", &
         RST   = ESC//"[0m"
      character(len=5)  :: color
      character(len=20) :: code_str
      character(:), allocatable :: line

      if (this%dbg .and. .not. this%ok) then
         select case (this%severity)
          case (ERROR);   sev_letter = "E"; color = RED
          case (WARNING); sev_letter = "W"; color = YEL
          case (INFO);    sev_letter = "I"; color = BLU
          case default;   sev_letter = "N"; color = GRY
         end select

         write(code_str,"(i0)") this%code

         line = color//"["//sev_letter//trim(code_str)//"]"//RST//" " // &
            "("//GRY//trim(this%location)//RST//") " // &
            trim(this%category)//": " // &
            trim(this%message)

         if (len_trim(this%suggestion) > 0) then
            line = line//" ["//trim(this%suggestion)//"]"
         end if

         write(*,"(a)") trim(line)
      end if
   end subroutine print_error