Line data Source code
1 : !> Error handling for the HSD parser
2 : !>
3 : !> This module provides error types and utilities for reporting parsing
4 : !> errors with file location information.
5 : module hsd_error
6 : implicit none (type, external)
7 : private
8 :
9 : public :: hsd_error_t
10 : public :: HSD_STAT_OK, HSD_STAT_SYNTAX_ERROR, HSD_STAT_UNCLOSED_TAG
11 : public :: HSD_STAT_UNCLOSED_ATTRIB, HSD_STAT_UNCLOSED_QUOTE
12 : public :: HSD_STAT_ORPHAN_TEXT, HSD_STAT_INCLUDE_CYCLE, HSD_STAT_INCLUDE_DEPTH
13 : public :: HSD_STAT_FILE_NOT_FOUND, HSD_STAT_IO_ERROR, HSD_STAT_TYPE_ERROR
14 : public :: HSD_STAT_NOT_FOUND
15 : public :: make_error, error_message
16 : public :: make_syntax_error, make_type_error
17 :
18 : !> Status codes
19 : integer, parameter :: HSD_STAT_OK = 0
20 : integer, parameter :: HSD_STAT_SYNTAX_ERROR = 1
21 : integer, parameter :: HSD_STAT_UNCLOSED_TAG = 2
22 : integer, parameter :: HSD_STAT_UNCLOSED_ATTRIB = 3
23 : integer, parameter :: HSD_STAT_UNCLOSED_QUOTE = 4
24 : integer, parameter :: HSD_STAT_ORPHAN_TEXT = 5
25 : integer, parameter :: HSD_STAT_INCLUDE_CYCLE = 6
26 : integer, parameter :: HSD_STAT_INCLUDE_DEPTH = 7
27 : integer, parameter :: HSD_STAT_FILE_NOT_FOUND = 8
28 : integer, parameter :: HSD_STAT_IO_ERROR = 9
29 : integer, parameter :: HSD_STAT_TYPE_ERROR = 10
30 : integer, parameter :: HSD_STAT_NOT_FOUND = 11
31 :
32 : !> Error type with detailed information
33 : type :: hsd_error_t
34 : !> Error code
35 : integer :: code = HSD_STAT_OK
36 : !> Human-readable error message
37 : character(len=:), allocatable :: message
38 : !> File where error occurred
39 : character(len=:), allocatable :: filename
40 : !> Line number where error started
41 : integer :: line_start = 0
42 : !> Line number where error ended
43 : integer :: line_end = 0
44 : !> Column number where error occurred (optional)
45 : integer :: column = 0
46 : !> Expected token or value (for context)
47 : character(len=:), allocatable :: expected
48 : !> Actual token or value that caused error
49 : character(len=:), allocatable :: actual
50 : !> Hint or suggestion for fixing the error
51 : character(len=:), allocatable :: hint
52 : contains
53 : procedure :: print => error_print
54 : end type hsd_error_t
55 :
56 : contains
57 :
58 : !> Create an error with message and location
59 53 : subroutine make_error(error, code, message, filename, line_start, line_end, column, &
60 : expected, actual, hint)
61 : type(hsd_error_t), allocatable, intent(out) :: error
62 : integer, intent(in) :: code
63 : character(len=*), intent(in) :: message
64 : character(len=*), intent(in), optional :: filename
65 : integer, intent(in), optional :: line_start
66 : integer, intent(in), optional :: line_end
67 : integer, intent(in), optional :: column
68 : character(len=*), intent(in), optional :: expected
69 : character(len=*), intent(in), optional :: actual
70 : character(len=*), intent(in), optional :: hint
71 :
72 53 : allocate(error)
73 53 : error%code = code
74 53 : error%message = message
75 :
76 53 : if (present(filename)) then
77 21 : error%filename = filename
78 : else
79 32 : error%filename = "<unknown>"
80 : end if
81 :
82 53 : if (present(line_start)) then
83 16 : error%line_start = line_start
84 : end if
85 :
86 53 : if (present(line_end)) then
87 4 : error%line_end = line_end
88 49 : else if (present(line_start)) then
89 12 : error%line_end = line_start
90 : end if
91 :
92 53 : if (present(column)) then
93 8 : error%column = column
94 : end if
95 :
96 53 : if (present(expected)) then
97 6 : error%expected = expected
98 : end if
99 :
100 53 : if (present(actual)) then
101 10 : error%actual = actual
102 : end if
103 :
104 53 : if (present(hint)) then
105 10 : error%hint = hint
106 : end if
107 :
108 106 : end subroutine make_error
109 :
110 : !> Get a descriptive message for an error code
111 15 : pure function error_message(code) result(msg)
112 : integer, intent(in) :: code
113 : character(len=:), allocatable :: msg
114 :
115 16 : select case (code)
116 : case (HSD_STAT_OK)
117 1 : msg = "No error"
118 : case (HSD_STAT_SYNTAX_ERROR)
119 1 : msg = "Syntax error"
120 : case (HSD_STAT_UNCLOSED_TAG)
121 1 : msg = "Unclosed tag"
122 : case (HSD_STAT_UNCLOSED_ATTRIB)
123 1 : msg = "Unclosed attribute"
124 : case (HSD_STAT_UNCLOSED_QUOTE)
125 1 : msg = "Unclosed quotation"
126 : case (HSD_STAT_ORPHAN_TEXT)
127 1 : msg = "Orphan text outside of any tag"
128 : case (HSD_STAT_INCLUDE_CYCLE)
129 1 : msg = "Cyclic include detected"
130 : case (HSD_STAT_INCLUDE_DEPTH)
131 1 : msg = "Maximum include depth exceeded"
132 : case (HSD_STAT_FILE_NOT_FOUND)
133 1 : msg = "File not found"
134 : case (HSD_STAT_IO_ERROR)
135 1 : msg = "I/O error"
136 : case (HSD_STAT_TYPE_ERROR)
137 1 : msg = "Type conversion error"
138 : case (HSD_STAT_NOT_FOUND)
139 1 : msg = "Key not found"
140 : case default
141 3 : msg = "Unknown error"
142 : end select
143 :
144 53 : end function error_message
145 :
146 : !> Print error to standard output
147 6 : subroutine error_print(self, unit)
148 : class(hsd_error_t), intent(in) :: self
149 : integer, intent(in), optional :: unit
150 :
151 6 : integer :: out_unit
152 : character(len=256) :: line_info, col_info
153 :
154 6 : if (present(unit)) then
155 5 : out_unit = unit
156 : else
157 1 : out_unit = 6 ! stdout
158 : end if
159 :
160 : ! Format location information
161 6 : if (allocated(self%filename) .and. self%line_start > 0) then
162 5 : if (self%line_end > self%line_start) then
163 4 : write(line_info, '(A,I0,A,I0)') "lines ", self%line_start, "-", self%line_end
164 : else
165 1 : write(line_info, '(A,I0)') "line ", self%line_start
166 : end if
167 :
168 5 : if (self%column > 0) then
169 3 : write(col_info, '(A,I0)') ", column ", self%column
170 : else
171 2 : col_info = ""
172 : end if
173 :
174 : write(out_unit, '(A,A,A,A,A,A,A)') &
175 5 : "Error in '", trim(self%filename), "' at ", trim(line_info), &
176 10 : trim(col_info), ": ", self%message
177 1 : else if (allocated(self%filename)) then
178 : write(out_unit, '(A,A,A,A)') &
179 0 : "Error in '", trim(self%filename), "': ", self%message
180 : else
181 : write(out_unit, '(A,A)') &
182 1 : "Error: ", self%message
183 : end if
184 :
185 : ! Print expected vs actual if available
186 6 : if (allocated(self%expected) .and. allocated(self%actual)) then
187 1 : write(out_unit, '(A,A)') " Expected: ", self%expected
188 1 : write(out_unit, '(A,A)') " Got: ", self%actual
189 5 : else if (allocated(self%expected)) then
190 1 : write(out_unit, '(A,A)') " Expected: ", self%expected
191 4 : else if (allocated(self%actual)) then
192 2 : write(out_unit, '(A,A)') " Got: ", self%actual
193 : end if
194 :
195 : ! Print hint if available
196 6 : if (allocated(self%hint)) then
197 4 : write(out_unit, '(A,A)') " Hint: ", self%hint
198 : end if
199 :
200 15 : end subroutine error_print
201 :
202 : !> Create a syntax error with expected vs actual context
203 2 : subroutine make_syntax_error(error, message, filename, line, column, expected, actual, hint)
204 : type(hsd_error_t), allocatable, intent(out) :: error
205 : character(len=*), intent(in) :: message
206 : character(len=*), intent(in), optional :: filename
207 : integer, intent(in), optional :: line
208 : integer, intent(in), optional :: column
209 : character(len=*), intent(in), optional :: expected
210 : character(len=*), intent(in), optional :: actual
211 : character(len=*), intent(in), optional :: hint
212 :
213 : call make_error(error, HSD_STAT_SYNTAX_ERROR, message, filename, &
214 : line_start=line, line_end=line, column=column, &
215 2 : expected=expected, actual=actual, hint=hint)
216 :
217 6 : end subroutine make_syntax_error
218 :
219 : !> Create a type error with expected vs actual types
220 3 : subroutine make_type_error(error, message, filename, line, expected, actual, hint)
221 : type(hsd_error_t), allocatable, intent(out) :: error
222 : character(len=*), intent(in) :: message
223 : character(len=*), intent(in), optional :: filename
224 : integer, intent(in), optional :: line
225 : character(len=*), intent(in), optional :: expected
226 : character(len=*), intent(in), optional :: actual
227 : character(len=*), intent(in), optional :: hint
228 :
229 : call make_error(error, HSD_STAT_TYPE_ERROR, message, filename, &
230 : line_start=line, line_end=line, &
231 3 : expected=expected, actual=actual, hint=hint)
232 :
233 2 : end subroutine make_type_error
234 :
235 3 : end module hsd_error
|
