io_error Subroutine

subroutine io_error(error, message, source, token, filename, line, label)

   !> Error handler
   type(error_type), allocatable, intent(out) :: error

   !> Main error message
   character(len=*), intent(in) :: message

   !> String representing the offending input
   character(len=*), intent(in) :: source

   !> Last processed token
   type(token_type), intent(in) :: token

   !> Name of the input file
   character(len=*), intent(in), optional :: filename

   !> Line number
   integer, intent(in), optional :: line

   !> Label of the offending statement
   character(len=*), intent(in), optional :: label

   character(len=*), parameter :: nl = new_line('a')
   integer :: offset, lnum, width
   character(len=:), allocatable :: string

   lnum = 1
   if (present(line)) lnum = line
   offset = integer_width(lnum)
   width = token%last - token%first + 1

   string = "Error: " // message

   if (present(filename)) then
      string = string // nl // &
         repeat(" ", offset)//"--> "//filename

      string = string // ":" // to_string(lnum)
      if (token%first > 0 .and. token%last >= token%first) then
         string = string // &
            ":"//to_string(token%first)
         if (token%last > token%first) string = string//"-"//to_string(token%last)
      end if
   end if

   string = string // nl //&
      repeat(" ", offset+1)//"|"//nl//&
      to_string(lnum)//" | "//source//nl//&
      repeat(" ", offset+1)//"|"//repeat(" ", token%first)//repeat("^", width)

   if (present(label)) then
      string = string // " " // label
   end if

   string = string // nl //&
      repeat(" ", offset+1)//"|"

   call fatal_error(error, string)
end subroutine io_error