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