|
3 | 3 | Author: Henny Sipma |
4 | 4 | ------------------------------------------------------------------------------ |
5 | 5 | The MIT License (MIT) |
6 | | - |
| 6 | +
|
7 | 7 | Copyright (c) 2005-2019 Kestrel Technology LLC |
8 | 8 | Copyright (c) 2020 Henny B. Sipma |
9 | 9 | Copyright (c) 2021-2025 Aarno Labs LLC |
|
14 | 14 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
15 | 15 | copies of the Software, and to permit persons to whom the Software is |
16 | 16 | furnished to do so, subject to the following conditions: |
17 | | - |
| 17 | +
|
18 | 18 | The above copyright notice and this permission notice shall be included in all |
19 | 19 | copies or substantial portions of the Software. |
20 | | - |
| 20 | +
|
21 | 21 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
22 | 22 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
23 | 23 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
|
27 | 27 | SOFTWARE. |
28 | 28 | ============================================================================= *) |
29 | 29 |
|
30 | | -(** Facility to record problems during a run of the analyzer. |
| 30 | +(** Facility to record problems during a run of the analyzer. |
31 | 31 |
|
32 | | - Typical use is to catch an exception, record the type of exception thrown |
| 32 | + Typical use is to catch an exception, record the type of exception thrown |
33 | 33 | with additional data in the logger: |
34 | 34 |
|
35 | 35 | chlog#add "Invalid_Argument" <reason for invalid argument> |
@@ -110,17 +110,17 @@ object |
110 | 110 | tags_discontinued <- tag :: tags_discontinued; |
111 | 111 | H.replace store tag ((STR "DISCONTINUED") :: entry) |
112 | 112 | end |
113 | | - else |
| 113 | + else |
114 | 114 | H.replace store tag (msg :: entry) |
115 | 115 |
|
116 | 116 | method reset = H.clear store |
117 | 117 |
|
118 | 118 | method size = H.fold (fun _ v a -> a + (List.length v)) store 0 |
119 | 119 |
|
120 | | - method tagsize (tag:string) = |
| 120 | + method tagsize (tag:string) = |
121 | 121 | if H.mem store tag then List.length (H.find store tag) else 0 |
122 | 122 |
|
123 | | - method toPretty = |
| 123 | + method toPretty = |
124 | 124 | let tags = ref [] in |
125 | 125 | let _ = H.iter (fun k _ -> tags := (k, H.find order k) :: !tags) store in |
126 | 126 | let tags = List.sort (fun (_, i1) (_, i2) -> Stdlib.compare i2 i1) !tags in |
@@ -151,8 +151,8 @@ object |
151 | 151 | STR ""); LBLOCK !pp; NL] |
152 | 152 |
|
153 | 153 | end |
154 | | - |
155 | | - |
| 154 | + |
| 155 | + |
156 | 156 | let mk_logger () = new logger_t |
157 | 157 |
|
158 | 158 | let chlog = new logger_t |
@@ -252,3 +252,17 @@ let log_result |
252 | 252 | chlog#add |
253 | 253 | (tag ^ filename ^ ":" ^ (string_of_int linenumber)) |
254 | 254 | (LBLOCK [STR msg; STR (String.concat "; " error)]) |
| 255 | + |
| 256 | + |
| 257 | +let log_diagnostics_result |
| 258 | + ?(msg="") |
| 259 | + ?(tag="") |
| 260 | + (filename: string) |
| 261 | + (linenumber: int) |
| 262 | + (msgs: string list) = |
| 263 | + if collect_diagnostics () then |
| 264 | + let tag = if tag = "" then tag else tag ^ ":" in |
| 265 | + let msg = if msg = "" then msg else msg ^ ":" in |
| 266 | + ch_diagnostics_log#add |
| 267 | + (tag ^ filename ^ ":" ^ (string_of_int linenumber)) |
| 268 | + (LBLOCK [STR msg; STR (String.concat "; " msgs)]) |
0 commit comments