1module m_xml_error 2! 3! Error handling 4! 5use m_elstack 6private 7 8type, public :: xml_error_t 9 character(len=100) :: message 10 integer :: line 11 integer :: column 12 type(elstack_t) :: stack 13 integer :: severity 14end type xml_error_t 15 16integer, public :: xml_stderr = 0 ! Unit for error info 17integer, public, parameter :: SEVERE_ERROR_CODE=0, WARNING_CODE=1 18 19public :: build_error_info, default_error_handler, general_error 20public :: set_xml_stderr 21 22CONTAINS 23 24!------------------------------------------------------------------------- 25subroutine build_error_info(error_info,message,line,column,stack,severity) 26type(xml_error_t), intent(out) :: error_info 27integer, intent(in) :: line, column 28character(len=*), intent(in) :: message 29type(elstack_t), intent(in) :: stack 30integer, intent(in) :: severity 31 32error_info%message = message 33error_info%line = line 34error_info%column = column 35error_info%stack = stack 36error_info%severity = severity 37 38end subroutine build_error_info 39 40!-------------------------------------------------- 41 42subroutine default_error_handler(error_info) 43type(xml_error_t), intent(in) :: error_info 44! 45! Default error handling 46! 47if (error_info%severity == SEVERE_ERROR_CODE) then 48 write(unit=xml_stderr,fmt="(a)") "*** XML parsing Error:" 49else if (error_info%severity == WARNING_CODE) then 50 write(unit=xml_stderr,fmt="(a)") "*** XML parsing Warning:" 51endif 52write(unit=xml_stderr,fmt="(a)") trim(error_info%message) 53write(unit=xml_stderr,fmt="(a,i8,a,i4)") "Line: ", & 54 error_info%line, & 55 " Column: ", & 56 error_info%column 57write(unit=xml_stderr,fmt="(a)") "Element traceback:" 58call print_elstack(error_info%stack,unit=xml_stderr) 59! 60! If there is a severe error the program should stop... 61! 62if (error_info%severity == SEVERE_ERROR_CODE) then 63 STOP 64else if (error_info%severity == WARNING_CODE) then 65 write(unit=xml_stderr,fmt="(a)") "*** Continuing after Warning..." 66endif 67 68end subroutine default_error_handler 69 70subroutine general_error(msg,code) 71character(len=*), intent(in) :: msg 72integer, intent(in) :: code 73! 74 75if (code == SEVERE_ERROR_CODE) then 76 write(unit=xml_stderr,fmt="(2a)") "** Error: ", msg 77 STOP 78else if (code == WARNING_CODE) then 79 write(unit=xml_stderr,fmt="(2a)") "** Warning: ", msg 80else 81 stop "wrong error code" 82endif 83 84end subroutine general_error 85 86!------------------------------------------------------------------------- 87subroutine set_xml_stderr(unit) 88integer, intent(in) :: unit 89 90xml_stderr = unit 91 92end subroutine set_xml_stderr 93 94end module m_xml_error 95 96 97 98 99 100 101