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