From 960b60d91b5ab4175efdd2a1a27f418177fae275 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 26 Feb 2026 10:47:34 -0500
Subject: [PATCH] test for TLS as ambient-span-provider

---
 src/tls/dune            | 11 ++++-----
 test/tls/dune           | 21 ++++++++++++++++
 test/tls/t_tls.expected |  5 ++++
 test/tls/t_tls.quine.ml | 10 ++++++++
 test/tls/t_tls.real.ml  | 54 +++++++++++++++++++++++++++++++++++++++++
 5 files changed, 95 insertions(+), 6 deletions(-)
 create mode 100644 test/tls/dune
 create mode 100644 test/tls/t_tls.expected
 create mode 100644 test/tls/t_tls.quine.ml
 create mode 100644 test/tls/t_tls.real.ml

diff --git a/src/tls/dune b/src/tls/dune
index f885110..c308577 100644
--- a/src/tls/dune
+++ b/src/tls/dune
@@ -1,7 +1,6 @@
-
 (library
-  (name trace_thread_local_storage)
-  (public_name trace.thread-local-storage)
-  (synopsis "Use thread-local-storage for ambient spans")
-  (optional) ; thread-local-storage
-  (libraries trace.core thread-local-storage))
+ (name trace_thread_local_storage)
+ (public_name trace.thread-local-storage)
+ (synopsis "Use thread-local-storage for ambient spans")
+ (optional) ; thread-local-storage
+ (libraries trace.core thread-local-storage))
diff --git a/test/tls/dune b/test/tls/dune
new file mode 100644
index 0000000..0ca3741
--- /dev/null
+++ b/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))))
diff --git a/test/tls/t_tls.expected b/test/tls/t_tls.expected
new file mode 100644
index 0000000..be758af
--- /dev/null
+++ b/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
diff --git a/test/tls/t_tls.quine.ml b/test/tls/t_tls.quine.ml
new file mode 100644
index 0000000..a9ee499
--- /dev/null
+++ b/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
diff --git a/test/tls/t_tls.real.ml b/test/tls/t_tls.real.ml
new file mode 100644
index 0000000..47022c3
--- /dev/null
+++ b/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 ())