simon/ocaml-trace
1
0
Fork 0
mirror of https://github.com/ocaml-tracing/ocaml-trace.git synced 2026-03-08 03:47:57 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

feat trace-tef: add a ticker thread to ensure we flush the file regularly

Browse source
This commit is contained in:
Simon Cruanes 2023-06-23 14:56:05 -04:00
parent ddc9cce5af
commit 345dd4a163
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
1 changed files with 15 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/tef/trace_tef.ml
View file

@ -33,6 +33,7 @@ let protect ~finally f =
Printexc.raise_with_backtrace exn bt Printexc.raise_with_backtrace exn bt
type event = type event =
| E_tick
| E_message of { | E_message of {
tid: int; tid: int;
msg: string; msg: string;
@ -104,6 +105,8 @@ module Writer = struct
flush self.oc; flush self.oc;
if self.must_close then close_out self.oc if self.must_close then close_out self.oc
let[@inline] flush (self : t) : unit = flush self.oc
let emit_sep_ (self : t) = let emit_sep_ (self : t) =
if self.first then if self.first then
self.first <- false self.first <- false
@ -206,6 +209,7 @@ let bg_thread ~out (events : event B_queue.t) : unit =
(* how to deal with an event *) (* how to deal with an event *)
let handle_ev (ev : event) : unit = let handle_ev (ev : event) : unit =
match ev with match ev with
| E_tick -> Writer.flush writer
| E_message { tid; msg; time_us; data } -> | E_message { tid; msg; time_us; data } ->
Writer.emit_instant_event ~tid ~name:msg ~ts:time_us ~args:data writer Writer.emit_instant_event ~tid ~name:msg ~ts:time_us ~args:data writer
| E_define_span { tid; name; id; time_us; data } -> | E_define_span { tid; name; id; time_us; data } ->
@ -243,6 +247,14 @@ let bg_thread ~out (events : event B_queue.t) : unit =
(Span_tbl.length spans); (Span_tbl.length spans);
() ()
let tick_thread events : unit =
try
while true do
Thread.delay 0.5;
B_queue.push events E_tick
done
with B_queue.Closed -> ()
type output = type output =
[ `Stdout [ `Stdout
| `Stderr | `Stderr
@ -262,6 +274,9 @@ let collector ~out () : collector =
(* writer thread. It receives events and writes them to [oc]. *) (* writer thread. It receives events and writes them to [oc]. *)
let t_write : Thread.t = Thread.create (fun () -> bg_thread ~out events) () let t_write : Thread.t = Thread.create (fun () -> bg_thread ~out events) ()
(* ticker thread, regularly sends a message to the writer thread *)
let t_tick : Thread.t = Thread.create (fun () -> tick_thread events) ()
let shutdown () = let shutdown () =
if A.exchange active false then ( if A.exchange active false then (
B_queue.close events; B_queue.close events;