test for TLS as ambient-span-provider

src/tls/dune

@@ -1,4 +1,3 @@
-
 (library
  (name trace_thread_local_storage)
  (public_name trace.thread-local-storage)

test/tls/dune

@@ -0,0 +1,21 @@
+(executable
+ (name t_tls)
+ (modules t_tls)
+ (libraries
+  trace
+  ; avoid using a recent dune with `enabled-if`, by just using `select` instead.
+  ; the dummy case just echoes back the expected file.
+  (select
+   t_tls.ml
+   from
+   (trace.thread-local-storage -> t_tls.real.ml)
+   (-> t_tls.quine.ml))))
+
+(rule
+ (alias runtest)
+ (action
+  (progn
+   (with-stdout-to
+    t_tls.output
+    (run %{exe:t_tls.exe} %{dep:t_tls.expected}))
+   (diff t_tls.expected t_tls.output))))

test/tls/t_tls.expected

@@ -0,0 +1,5 @@
+=== ambient span (TLS) ===
+before any span: none
+in outer: outer
+in inner: inner
+after inner exits: outer

test/tls/t_tls.quine.ml

@@ -0,0 +1,10 @@
+(* When trace.thread-local-storage is unavailable, echo the expected file
+   so the diff always passes. The file is passed as argv[1] by the dune rule. *)
+let () =
+  let ic = open_in Sys.argv.(1) in
+  (try
+     while true do
+       print_char (input_char ic)
+     done
+   with End_of_file -> ());
+  close_in ic

test/tls/t_tls.real.ml

@@ -0,0 +1,54 @@
+(* Test ambient span tracking via thread-local-storage provider *)
+
+let ( let@ ) = ( @@ )
+
+(* Unique span type so we can identify spans by name *)
+type Trace_core.span += Named of string
+
+let make_recorder () =
+  let open Trace_core.Collector in
+  let cbs =
+    Callbacks.make
+      ~enter_span:(fun
+          ()
+          ~__FUNCTION__:_
+          ~__FILE__:_
+          ~__LINE__:_
+          ~level:_
+          ~params:_
+          ~data:_
+          ~parent:_
+          name
+        -> Named name)
+      ~exit_span:(fun () _sp -> ())
+      ~add_data_to_span:(fun () _sp _data -> ())
+      ~message:(fun () ~level:_ ~params:_ ~data:_ ~span:_ _msg -> ())
+      ~metric:(fun () ~level:_ ~params:_ ~data:_ _name _m -> ())
+      ()
+  in
+  C_some ((), cbs)
+
+let current_name () =
+  match Trace_core.current_span () with
+  | None -> "none"
+  | Some (Named s) -> s
+  | Some _ -> "<other>"
+
+let () =
+  print_endline "=== ambient span (TLS) ===";
+  Trace_thread_local_storage.setup ();
+  let coll = make_recorder () in
+  let@ () = Trace_core.with_setup_collector coll in
+
+  Printf.printf "before any span: %s\n" (current_name ());
+
+  let@ _outer = Trace_core.with_span ~__FILE__ ~__LINE__ "outer" in
+  Printf.printf "in outer: %s\n" (current_name ());
+
+  (* inner span is scoped to just the one printf *)
+  (let@ _inner = Trace_core.with_span ~__FILE__ ~__LINE__ "inner" in
+   ignore _inner;
+   Printf.printf "in inner: %s\n" (current_name ()));
+
+  (* inner has exited, outer span is restored *)
+  Printf.printf "after inner exits: %s\n" (current_name ())