fix otel-lwt: logic for tracer.with_ was invalid

sometimes spans would be dropped!
This commit is contained in:
Simon Cruanes 2025-12-25 01:21:12 -05:00
parent 3b6e239c17
commit b4b864a0b6
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4

View file

@ -25,23 +25,29 @@ module Tracer = struct
let with_ (type a) ?(tracer = dynamic_main) ?force_new_trace_id ?trace_state let with_ (type a) ?(tracer = dynamic_main) ?force_new_trace_id ?trace_state
?attrs ?kind ?trace_id ?parent ?links name (cb : Span.t -> a Lwt.t) : ?attrs ?kind ?trace_id ?parent ?links name (cb : Span.t -> a Lwt.t) :
a Lwt.t = a Lwt.t =
let open Lwt.Syntax in
let thunk, finally = let thunk, finally =
with_thunk_and_finally tracer ?force_new_trace_id ?trace_state ?attrs with_thunk_and_finally tracer ?force_new_trace_id ?trace_state ?attrs
?kind ?trace_id ?parent ?links name cb ?kind ?trace_id ?parent ?links name cb
in in
match thunk () with let* r =
| exception exn -> Lwt.catch
let bt = Printexc.get_raw_backtrace () in (fun () ->
finally (Error (exn, bt)); let+ res = thunk () in
Printexc.raise_with_backtrace exn bt Ok res)
| promise ->
Lwt.on_any promise
(fun _ -> finally (Ok ()))
(fun exn -> (fun exn ->
let bt = Printexc.get_raw_backtrace () in let bt = Printexc.get_raw_backtrace () in
finally (Error (exn, bt))); Lwt.return (Error (exn, bt)))
promise in
match r with
| Ok r ->
finally (Ok ());
Lwt.return r
| Error (exn, bt) ->
finally (Error (exn, bt));
Lwt.fail exn
end end
module Trace = Tracer [@@deprecated "use Tracer"] module Trace = Tracer [@@deprecated "use Tracer"]