source: vendors/XMLF90/current/src/sax/m_xml_error.f90 @ 1967

module m_xml_error
!
! Error handling
!
use m_elstack
private

type, public  :: xml_error_t
      character(len=100)  :: message
      integer             :: line
      integer             :: column
      type(elstack_t)     :: stack
      integer             :: severity
end type xml_error_t

integer, public             ::  xml_stderr = 0    ! Unit for error info
integer, public, parameter  ::  SEVERE_ERROR_CODE=0, WARNING_CODE=1

public  :: build_error_info, default_error_handler
public  :: set_xml_stderr

CONTAINS

!-------------------------------------------------------------------------
subroutine build_error_info(error_info,message,line,column,stack,severity)
type(xml_error_t), intent(out)        :: error_info
integer, intent(in)                   :: line, column
character(len=*), intent(in)          :: message
type(elstack_t), intent(in)           :: stack
integer, intent(in)                   :: severity

error_info%message = message
error_info%line = line
error_info%column = column
error_info%stack = stack
error_info%severity = severity

end subroutine build_error_info

!--------------------------------------------------

subroutine default_error_handler(error_info)
type(xml_error_t), intent(in)            :: error_info
!
! Default error handling
!
if (error_info%severity == SEVERE_ERROR_CODE)  then
   write(unit=xml_stderr,fmt="(a)") "*** XML parsing Error:"
else if (error_info%severity == WARNING_CODE)  then
   write(unit=xml_stderr,fmt="(a)") "*** XML parsing Warning:"
endif
write(unit=xml_stderr,fmt="(a)") trim(error_info%message)
write(unit=xml_stderr,fmt="(a,i8,a,i4)") "Line: ", &
                                         error_info%line, &
                                         " Column: ", &
                                         error_info%column
write(unit=xml_stderr,fmt="(a)") "Element traceback:"
call print_elstack(error_info%stack,unit=xml_stderr)
!
!   If there is a severe error the program should stop...
!
if (error_info%severity == SEVERE_ERROR_CODE)  then
      STOP
else if (error_info%severity == WARNING_CODE)  then
   write(unit=xml_stderr,fmt="(a)") "*** Continuing after Warning..."
endif

end subroutine default_error_handler

!-------------------------------------------------------------------------
subroutine set_xml_stderr(unit)
integer, intent(in)  :: unit

xml_stderr  = unit

end subroutine set_xml_stderr

end module m_xml_error