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