gazagnaire.org
Trace Event Format summary CLI
4.3 kB
112 lines
1(*---------------------------------------------------------------------------
2 Copyright (c) 2026 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6module Event = Catapult.Event
7module Phase = Catapult.Phase
8
9let trace = Alcotest.testable Catapult.pp Catapult.equal
10
11let roundtrip name t =
12 (match Catapult.of_protobuf (Catapult.to_protobuf t) with
13 | Ok t' -> Alcotest.check trace name t t'
14 | Error e -> Alcotest.failf "%s: %s" name (Protobuf.Error.to_string e));
15 let r = Bytesrw.Bytes.Reader.of_string (Catapult.to_protobuf t) in
16 Alcotest.check trace (name ^ " (reader)") t
17 (Catapult.of_protobuf_reader_exn r)
18
19(* Every typed event member plus open-ended args, extra, metadata, frames and
20 samples round-trips unchanged. *)
21let test_full () =
22 roundtrip "full"
23 (Catapult.v ~display_time_unit:`Ns
24 ~metadata:[ ("version", Json.string "1") ]
25 ~stack_frames:
26 [ ("5", Catapult.Frame.v ~category:"core" ~name:"main" ()) ]
27 ~samples:
28 [
29 Catapult.Sample.v ~cpu:0 ~tid:1 ~sf:(Event.Int 5) ~name:"cycles"
30 ~ts:1. ();
31 ]
32 [
33 Event.complete ~cat:[ "a"; "b" ] ~pid:1 ~tid:1 ~name:"work" ~ts:10.
34 ~dur:5.
35 ~args:
36 [
37 ("minor_words", Json.int 1024);
38 ("ratio", Json.number 1.5);
39 ("rule", Json.string "allow");
40 ]
41 ();
42 Event.v ~pid:1 ~tid:1 ~ts:20. ~id:(Event.String "s1")
43 ~args:[ ("parent", Json.string "p") ]
44 Phase.Async_begin;
45 Event.instant ~pid:1 ~tid:1 ~name:"tick" ~ts:30. ~scope:Process ();
46 Event.counter ~pid:1 ~name:"mem" ~ts:40. [ ("heap", Json.int 42) ];
47 ])
48
49let test_empty () = roundtrip "empty" (Catapult.v [])
50
51(* Each branch of the value oneof: bool, signed and unsigned integers, real,
52 string, null, and the JSON-text fallback for nested arrays and objects. The
53 unsigned value (2^64 - 1) does not fit a signed integer, so it exercises the
54 distinct Uint case rather than canonicalising to Int. *)
55let test_value_branches () =
56 let args =
57 [
58 ("b", Json.bool true);
59 ("i", Json.int (-7));
60 ("u", Json.uint64 (-1L));
61 ("f", Json.number 3.5);
62 ("s", Json.string "x");
63 ("nil", Json.null ());
64 ("arr", Json.Value.of_string_exn "[1,2,3]");
65 ("obj", Json.Value.of_string_exn {|{"k":1,"n":[true,null]}|});
66 ]
67 in
68 roundtrip "value branches"
69 (Catapult.v [ Event.instant ~pid:1 ~name:"e" ~ts:1. ~args () ])
70
71let events =
72 [
73 Event.v ~pid:1 ~tid:1 ~ts:10. ~id:(Event.String "1") Phase.Async_begin;
74 Event.complete ~pid:1 ~tid:1 ~name:"step" ~ts:12. ~dur:3.
75 ~args:[ ("minor_words", Json.int 64) ]
76 ();
77 Event.counter ~pid:1 ~name:"mem" ~ts:14. [ ("heap", Json.int 7) ];
78 Event.v ~pid:1 ~tid:1 ~ts:20. ~id:(Event.String "1") Phase.Async_end;
79 ]
80
81(* Folding the protobuf events yields exactly the trace's events, in order, and
82 without building the list. *)
83let test_fold () =
84 let pb = Catapult.to_protobuf (Catapult.v events) in
85 match
86 Catapult.fold_protobuf_events ~init:[] ~f:(fun acc e -> e :: acc) pb
87 with
88 | Error e -> Alcotest.failf "fold: %s" (Protobuf.Error.to_string e)
89 | Ok rev ->
90 Alcotest.check trace "folded events" (Catapult.v events)
91 (Catapult.v (List.rev rev))
92
93(* A producer that crashed mid-write leaves a truncated final event; the fold
94 keeps the complete events before it. *)
95let test_fold_truncated () =
96 let pb = Catapult.to_protobuf (Catapult.v events) in
97 let truncated = String.sub pb 0 (String.length pb - 3) in
98 match
99 Catapult.fold_protobuf_events ~init:0 ~f:(fun n _ -> n + 1) truncated
100 with
101 | Error e -> Alcotest.failf "fold truncated: %s" (Protobuf.Error.to_string e)
102 | Ok n -> Alcotest.(check int) "kept complete events" 3 n
103
104let suite =
105 ( "pb",
106 [
107 Alcotest.test_case "full" `Quick test_full;
108 Alcotest.test_case "empty" `Quick test_empty;
109 Alcotest.test_case "value branches" `Quick test_value_branches;
110 Alcotest.test_case "fold events" `Quick test_fold;
111 Alcotest.test_case "fold truncated" `Quick test_fold_truncated;
112 ] )