ocaml-trace/test/t_runtime_events.ml

(** Test program for the Runtime_events backend.

    This demonstrates and tests the Runtime_events backend by: 1. Emitting trace
    events 2. Subscribing to the ringbuffer 3. Collecting all events 4.
    Verifying expected events were emitted *)

let ( let@ ) = ( @@ )

(* Event types we'll collect *)
type collected_event =
  | Span_enter of string
  | Span_exit of string
  | Message of string
  | Metric_int of string * int
  | Metric_float of string * float

(* Simple recursive function to generate some trace activity *)
let rec fib x =
  let%trace () = "fib" in
  if x <= 2 then
    1
  else
    fib (x - 1) + fib (x - 2)

(* Function with explicit span *)
let do_work () =
  Trace_core.with_span ~__FILE__ ~__LINE__ "do_work" @@ fun _sp ->
  Trace_core.message "Starting work";
  Trace_core.counter_int "work_units" 100;

  let result = fib 10 in

  Trace_core.messagef (fun k -> k "Computed fib(10) = %d" result);
  Trace_core.counter_int "work_units" 200;
  result

(* Subscribe to runtime events and collect them *)
let collect_events () =
  let events = ref [] in

  (* Create a cursor to read from our own process *)
  let cursor = Runtime_events.create_cursor None in

  (* Set up callbacks *)
  let callbacks =
    Runtime_events.Callbacks.create ()
    (* Register callbacks for our custom events using type values *)
    |> Runtime_events.Callbacks.add_user_event
         Trace_runtime_events.String_type.ty (fun _domain_id _ts tag name ->
           match Runtime_events.User.tag tag with
           | Trace_runtime_events.Events.Tag_span_enter ->
             events := Span_enter name :: !events
           | Trace_runtime_events.Events.Tag_span_exit ->
             events := Span_exit name :: !events
           | Trace_runtime_events.Events.Tag_message ->
             events := Message name :: !events
           | _ -> ())
    |> Runtime_events.Callbacks.add_user_event
         Trace_runtime_events.String_int.ty
         (fun _domain_id _ts tag (name, value) ->
           match Runtime_events.User.tag tag with
           | Trace_runtime_events.Events.Tag_metric_int ->
             events := Metric_int (name, value) :: !events
           | _ -> ())
    |> Runtime_events.Callbacks.add_user_event
         Trace_runtime_events.String_float.ty
         (fun _domain_id _ts tag (name, value) ->
           match Runtime_events.User.tag tag with
           | Trace_runtime_events.Events.Tag_metric_float ->
             events := Metric_float (name, value) :: !events
           | _ -> ())
  in

  (* Read all events from the ringbuffer *)
  let _lost_events = Runtime_events.read_poll cursor callbacks None in

  List.rev !events

let () =
  (* Initialize the Runtime_events backend with start_events=false
     so we can manually control when to start *)
  Trace_runtime_events.setup ~start_events:false ();

  (* Start runtime events *)
  Runtime_events.start ();

  (* Set process and thread names *)
  Trace_core.set_process_name "test";
  Trace_core.set_thread_name "main";

  (* Do some traced work *)
  let result = do_work () in
  Printf.eprintf "result: %d\n" result;

  (* Collect events from the ringbuffer *)
  let events = collect_events () in

  Printf.eprintf "\ncollected %d events:\n" (List.length events);
  List.iter
    (fun ev ->
      match ev with
      | Span_enter name -> Printf.eprintf "  - span enter: %s\n" name
      | Span_exit name -> Printf.eprintf "  - span exit: %s\n" name
      | Message msg -> Printf.eprintf "  - message: %s\n" msg
      | Metric_int (name, value) ->
        Printf.eprintf "  - metric int: %s = %d\n" name value
      | Metric_float (name, value) ->
        Printf.eprintf "  - metric float: %s = %f\n" name value)
    events;

  (* Verify expected events *)
  let has_do_work_enter =
    List.exists
      (function
        | Span_enter "do_work" -> true
        | _ -> false)
      events
  in
  let has_do_work_exit =
    List.exists
      (function
        | Span_exit "do_work" -> true
        | _ -> false)
      events
  in
  let has_fib_spans =
    List.filter
      (function
        | Span_enter "fib" | Span_exit "fib" -> true
        | _ -> false)
      events
  in
  let has_starting_work =
    List.exists
      (function
        | Message "Starting work" -> true
        | _ -> false)
      events
  in
  let has_metrics =
    List.filter
      (function
        | Metric_int ("work_units", _) -> true
        | _ -> false)
      events
  in

  Printf.eprintf "\nVerification:\n";
  Printf.eprintf "  - do_work span enter: %b\n" has_do_work_enter;
  Printf.eprintf "  - do_work span exit: %b\n" has_do_work_exit;
  Printf.eprintf "  - fib spans (enter+exit): %d\n" (List.length has_fib_spans);
  Printf.eprintf "  - 'Starting work' message: %b\n" has_starting_work;
  Printf.eprintf "  - work_units metrics: %d\n" (List.length has_metrics);

  (* Check assertions *)
  assert has_do_work_enter;
  assert has_do_work_exit;
  assert (List.length has_fib_spans = 218);
  assert has_starting_work;
  assert (List.length has_metrics = 2);

  Printf.eprintf "\nall good :-)\n";

  Trace_core.shutdown ()