Skip to content

Commit 4c65f6f

Browse files
committed
CHUTIL: add option to log to diagnostic log
1 parent 8ff9d1f commit 4c65f6f

File tree

2 files changed

+33
-10
lines changed

2 files changed

+33
-10
lines changed

CodeHawk/CH/chutil/cHLogger.ml

Lines changed: 24 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
Author: Henny Sipma
44
------------------------------------------------------------------------------
55
The MIT License (MIT)
6-
6+
77
Copyright (c) 2005-2019 Kestrel Technology LLC
88
Copyright (c) 2020 Henny B. Sipma
99
Copyright (c) 2021-2025 Aarno Labs LLC
@@ -14,10 +14,10 @@
1414
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
1515
copies of the Software, and to permit persons to whom the Software is
1616
furnished to do so, subject to the following conditions:
17-
17+
1818
The above copyright notice and this permission notice shall be included in all
1919
copies or substantial portions of the Software.
20-
20+
2121
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
2222
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
2323
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
@@ -27,9 +27,9 @@
2727
SOFTWARE.
2828
============================================================================= *)
2929

30-
(** Facility to record problems during a run of the analyzer.
30+
(** Facility to record problems during a run of the analyzer.
3131
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
3333
with additional data in the logger:
3434
3535
chlog#add "Invalid_Argument" <reason for invalid argument>
@@ -110,17 +110,17 @@ object
110110
tags_discontinued <- tag :: tags_discontinued;
111111
H.replace store tag ((STR "DISCONTINUED") :: entry)
112112
end
113-
else
113+
else
114114
H.replace store tag (msg :: entry)
115115

116116
method reset = H.clear store
117117

118118
method size = H.fold (fun _ v a -> a + (List.length v)) store 0
119119

120-
method tagsize (tag:string) =
120+
method tagsize (tag:string) =
121121
if H.mem store tag then List.length (H.find store tag) else 0
122122

123-
method toPretty =
123+
method toPretty =
124124
let tags = ref [] in
125125
let _ = H.iter (fun k _ -> tags := (k, H.find order k) :: !tags) store in
126126
let tags = List.sort (fun (_, i1) (_, i2) -> Stdlib.compare i2 i1) !tags in
@@ -151,8 +151,8 @@ object
151151
STR ""); LBLOCK !pp; NL]
152152

153153
end
154-
155-
154+
155+
156156
let mk_logger () = new logger_t
157157

158158
let chlog = new logger_t
@@ -252,3 +252,17 @@ let log_result
252252
chlog#add
253253
(tag ^ filename ^ ":" ^ (string_of_int linenumber))
254254
(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)])

CodeHawk/CH/chutil/cHLogger.mli

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -128,3 +128,12 @@ val log_error_result:
128128
making up [error].*)
129129
val log_result:
130130
?msg:string -> ?tag:string -> string -> int -> string list -> unit
131+
132+
133+
(** [log_diagnostics_result msg tag filename linenumber error] writes an entry to
134+
[ch_diagnostics_log] with a tag that combines [tag], [filename], and
135+
[linenumber].
136+
The entry is the concatenation of [msg] and the list of error messages
137+
making up [error].*)
138+
val log_diagnostics_result:
139+
?msg:string -> ?tag:string -> string -> int -> string list -> unit

0 commit comments

Comments
 (0)