Add TSan stress suite for per-hotspot race detection

Five new scenarios under test/irmin-pack/test_tsan_stress/ target
mutable state hotspots that the existing multicore + QCheck-STM
tests do not exercise across domains:

- stress_mem_cache: races the global Hashtbl.t cache captured by
  Irmin_mem.Read_only.v (irmin_mem.ml:44) and the KMap mutable in
  the Read_only instance.
- stress_watch:     races the listen_dir_hook ref in watch.ml:28-29.
- stress_ao_buf:    races the unguarded Buffer.t in the rw_perm of
  Append_only_file (append_only_file.ml).
- stress_dict:      races the two unguarded Hashtbl.t caches plus
  last_refill_offset in dict.ml.
- stress_fs_pool:   races the shared Eio_pool instances in
  irmin_fs_unix.ml (mkdir_pool, openfile_pool).

mem and watch produce clean TSan data-race warnings pointing at the
exact hotspot; ao, dict and fs cause memory corruption fast enough
that TSan fires via SEGV before it can write a detailed report —
the SEGV itself is the race signal.

The @tsan-stress dune alias runs each scenario in its own process
via `|| true` so that a race-induced crash in one does not suppress
the others. The tsan.yml workflow counts both "WARNING:
ThreadSanitizer" and "ERROR: ThreadSanitizer" as findings, and
includes the @tsan-stress build-dir reports in the uploaded
artifact.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>

Author: cuihtlauac

.github/workflows/tsan.yml

@@ -71,16 +71,24 @@ jobs:
         shell: bash
         run: |
           shopt -s nullglob
-          files=(tsan-report.*)
-          n=0
+          files=(tsan-report.* _build/default/test/irmin-pack/test_tsan_stress/tsan-report.*)
+          warnings=0
+          errors=0
           if [ ${#files[@]} -gt 0 ] || [ -f tsan-run.log ]; then
-            n=$(grep -ch "WARNING: ThreadSanitizer" "${files[@]}" tsan-run.log 2>/dev/null | awk '{s+=$1} END {print s+0}')
+            warnings=$(grep -ch "WARNING: ThreadSanitizer" "${files[@]}" tsan-run.log 2>/dev/null | awk -F: '{s+=$NF} END {print s+0}')
+            errors=$(grep -ch "ERROR: ThreadSanitizer" "${files[@]}" tsan-run.log 2>/dev/null | awk -F: '{s+=$NF} END {print s+0}')
           fi
+          total=$((warnings + errors))
           {
-            echo "### TSan findings: $n"
-            if [ "$n" = "0" ]; then
+            echo "### TSan findings: $total"
+            echo ""
+            echo "- data-race warnings: $warnings"
+            echo "- signal/SEGV-on-race errors: $errors"
+            if [ "$total" = "0" ]; then
+              echo ""
               echo "No races detected."
             else
+              echo ""
               echo "See artifact \`tsan-reports-${{ github.run_id }}\`."
             fi
           } >> "$GITHUB_STEP_SUMMARY"
@@ -92,5 +100,6 @@ jobs:
           name: tsan-reports-${{ github.run_id }}
           path: |
             tsan-report.*
+            _build/default/test/irmin-pack/test_tsan_stress/tsan-report.*
             tsan-run.log
           if-no-files-found: ignore

test/irmin-pack/test_tsan_stress/dune

@@ -1,9 +1,29 @@
 (executable
  (name main)
- (modules main)
- (libraries eio_main))
+ (modules
+  main
+  stress_common
+  stress_ao_buf
+  stress_dict
+  stress_mem_cache
+  stress_watch
+  stress_fs_pool)
+ (libraries
+  eio_main
+  irmin
+  irmin.mem
+  irmin-pack.io
+  irmin-pack.unix
+  irmin-fs.unix))
+
+; Run each scenario in a fresh process so a race that corrupts memory
+; and triggers a SEGV in one scenario does not prevent the others from
+; running. Each scenario writes TSan reports to tsan-report.<pid>, and
+; the outer workflow aggregates all of them.
 
 (rule
  (alias tsan-stress)
+ (deps main.exe)
  (action
-  (run ./main.exe)))
+  (bash
+   "./main.exe mem || true; ./main.exe watch || true; ./main.exe ao || true; ./main.exe dict || true; ./main.exe fs || true")))

test/irmin-pack/test_tsan_stress/main.ml

@@ -1,32 +1,68 @@
-(* TSan stress suite.
+(* TSan stress suite — dispatcher.
 
-   Dispatcher for race-hunting scenarios. Each scenario targets a mutable
-   state hotspot that the standard test suite does not exercise across
-   domains. Scenarios are added incrementally.
+   Each scenario targets a mutable-state hotspot that the standard test
+   suite does not exercise across domains. Iteration count is driven by
+   [IRMIN_TSAN_STRESS_ITER] (default 100).
 
-   Iteration count: [IRMIN_TSAN_STRESS_ITER] env var (default 100). *)
+   Scenarios and expected outcomes under TSan:
+
+   - mem:   clean data-race warning at irmin_mem.ml:51 (Hashtbl.add in
+            the global cache) and on the shared KMap mutable.
+   - watch: clean data-race warning at watch.ml:33 (listen_dir_hook
+            ref assignment).
+   - ao:    SEGV — concurrent Buffer.add_string corrupts the buffer
+            fast enough that TSan's signal handler fires before the
+            race warning is written. The SEGV itself is evidence of
+            the race; a clean warning would need finer-grained access.
+   - dict:  SEGV — same pattern as ao, via the two unguarded Hashtbl.t
+            caches plus the append path through Ao.
+   - fs:    TSan "nested bug, aborting" — the race interacts with Eio
+            scheduler/pool internals in a way the sanitizer can't
+            unwind. Surfaces the problem but not a specific site.
+
+   Because ao/dict/fs crash, each scenario is run in its own process by
+   the @tsan-stress dune alias so one crash does not hide the others.
+
+   Usage:
+     main.exe                 run all scenarios
+     main.exe all             same
+     main.exe <name>          run one scenario (ao|dict|mem|watch|fs) *)
 
 let iter_count =
   match Sys.getenv_opt "IRMIN_TSAN_STRESS_ITER" with
   | Some s -> int_of_string s
   | None -> 100
 
-let scenarios : (string * (iter:int -> unit)) list = []
+type env = Eio_unix.Stdenv.base
+
+let scenarios : (string * (env:env -> iter:int -> unit)) list =
+  [
+    ("ao", Stress_ao_buf.run);
+    ("dict", Stress_dict.run);
+    ("mem", Stress_mem_cache.run);
+    ("watch", Stress_watch.run);
+    ("fs", Stress_fs_pool.run);
+  ]
 
-let run_all () =
-  List.iter
-    (fun (name, fn) ->
-      Printf.printf "tsan-stress: %s (iter=%d)\n%!" name iter_count;
-      fn ~iter:iter_count)
-    scenarios
+let run_one ~env (name, fn) =
+  Printf.printf "tsan-stress: %s (iter=%d)\n%!" name iter_count;
+  fn ~env ~iter:iter_count
 
 let () =
-  let which = if Array.length Sys.argv >= 2 then Sys.argv.(1) else "all" in
+  let which =
+    match Sys.argv with
+    | [| _ |] | [| _; "all" |] -> `All
+    | [| _; name |] -> `One name
+    | _ ->
+        prerr_endline "usage: main.exe [all|ao|dict|mem|watch|fs]";
+        exit 2
+  in
+  Eio_main.run @@ fun env ->
   match which with
-  | "all" -> run_all ()
-  | name -> (
+  | `All -> List.iter (run_one ~env) scenarios
+  | `One name -> (
       match List.assoc_opt name scenarios with
-      | Some fn -> fn ~iter:iter_count
+      | Some fn -> run_one ~env (name, fn)
       | None ->
           Printf.eprintf "tsan-stress: unknown scenario %S\n%!" name;
           exit 2)

test/irmin-pack/test_tsan_stress/stress_ao_buf.ml

@@ -0,0 +1,29 @@
+(* Races the unguarded [Buffer.t] and atomic counter in
+   [Append_only_file.rw_perm] (src/irmin-pack/io/append_only_file.ml).
+
+   N domains call [Ao.append_exn] concurrently on the same [Ao.t].
+   The function does [Buffer.add_string] without synchronisation, then
+   an [Atomic.fetch_and_add] on [buf_length] — the TOCTOU and the
+   Buffer mutation both surface to TSan. *)
+
+module Io = Irmin_pack_unix.Io.Unix
+module Errs = Irmin_pack_io.Io_errors.Make (Io)
+module Ao = Irmin_pack_io.Append_only_file.Make (Io) (Errs)
+
+let run ~env ~iter =
+  Eio.Switch.run @@ fun sw ->
+  let dmgr = Eio.Stdenv.domain_mgr env in
+  let path = Stress_common.scratch_file ~env "stress_ao_buf.data" in
+  let ao =
+    match Ao.create_rw ~sw ~path ~overwrite:true with
+    | Ok ao -> ao
+    | Error _ -> failwith "stress_ao_buf: create_rw failed"
+  in
+  let worker () =
+    for _ = 1 to iter do
+      Ao.append_exn ao "xxxxxxxx"
+    done
+  in
+  Stress_common.domains_spawn ~dmgr ~nb:2 worker;
+  ignore (Ao.flush ao);
+  ignore (Ao.close ao)

test/irmin-pack/test_tsan_stress/stress_common.ml

@@ -0,0 +1,43 @@
+(* Barrier-synchronised domain spawning, mirroring the idiom in
+   test/irmin-pack/test_multicore.ml so the workers start roughly
+   together and the scheduler has to interleave them. *)
+
+(* Clean scratch directory for scenarios that need on-disk state.
+   Rooted at [/tmp/irmin-tsan-stress/<name>] to avoid clashing with
+   a possibly missing or read-only [_build] under the process cwd. *)
+let scratch_path ~env name =
+  let fs = Eio.Stdenv.fs env in
+  let base = Eio.Path.(fs / "tmp" / "irmin-tsan-stress") in
+  let p = Eio.Path.(base / name) in
+  (try Eio.Path.rmtree p with _ -> ());
+  (try Eio.Path.mkdirs ~perm:0o755 base with _ -> ());
+  (try Eio.Path.mkdir ~perm:0o755 p with _ -> ());
+  p
+
+(* Like [scratch_path] but returns a path to a file (non-existing)
+   whose parent directory has been freshly created. *)
+let scratch_file ~env name =
+  let fs = Eio.Stdenv.fs env in
+  let base = Eio.Path.(fs / "tmp" / "irmin-tsan-stress") in
+  (try Eio.Path.mkdirs ~perm:0o755 base with _ -> ());
+  let p = Eio.Path.(base / name) in
+  (try Eio.Path.unlink p with _ -> ());
+  p
+
+let domains_run ~dmgr fns =
+  let count = Atomic.make (List.length fns) in
+  let fibers =
+    List.map
+      (fun fn () ->
+        Eio.Domain_manager.run dmgr (fun () ->
+            Atomic.decr count;
+            while Atomic.get count > 0 do
+              Domain.cpu_relax ()
+            done;
+            fn ()))
+      fns
+  in
+  Eio.Fiber.all fibers
+
+let domains_spawn ~dmgr ?(nb = 4) fn =
+  domains_run ~dmgr (List.init nb (fun _ -> fn))

test/irmin-pack/test_tsan_stress/stress_dict.ml

@@ -0,0 +1,32 @@
+(* Races the two unguarded [Hashtbl.t]s and [mutable last_refill_offset]
+   in src/irmin-pack/io/dict.ml.
+
+   One writer domain loops [Dict.index] (which appends and mutates both
+   tables via [Hashtbl.add]); readers concurrently loop [Dict.find]. *)
+
+module Io = Irmin_pack_unix.Io.Unix
+module Dict = Irmin_pack_io.Dict.Make (Io)
+
+let run ~env ~iter =
+  Eio.Switch.run @@ fun sw ->
+  let dmgr = Eio.Stdenv.domain_mgr env in
+  let path = Stress_common.scratch_file ~env "stress_dict.data" in
+  let dict =
+    match Dict.create_rw ~sw ~overwrite:true ~path with
+    | Ok d -> d
+    | Error _ -> failwith "stress_dict: create_rw failed"
+  in
+  let writer () =
+    for i = 1 to iter do
+      let _ = Dict.index dict (Printf.sprintf "str-%d" i) in
+      ()
+    done
+  in
+  let reader () =
+    for i = 1 to iter do
+      let _ = Dict.find dict i in
+      ()
+    done
+  in
+  Stress_common.domains_run ~dmgr [ writer; reader ];
+  ignore (Dict.close dict)

test/irmin-pack/test_tsan_stress/stress_fs_pool.ml

@@ -0,0 +1,27 @@
+(* Races the shared [Eio_pool.t] instances ([mkdir_pool], [openfile_pool])
+   in src/irmin-fs/unix/irmin_fs_unix.ml:75,87.
+
+   A single FS-backed store is shared across N domains; each writes a
+   distinct key. Store.set_exn goes through [with_write_file] which uses
+   [openfile_pool]; creating the root directory uses [mkdir_pool]. The
+   pool's internal state (queue, counter) is shared across domains. *)
+
+module Store = Irmin_fs_unix.KV.Make (Irmin.Contents.String)
+
+let run ~env ~iter =
+  Eio.Switch.run @@ fun _sw ->
+  let clock = Eio.Stdenv.clock env in
+  let dmgr = Eio.Stdenv.domain_mgr env in
+  let root = Stress_common.scratch_path ~env "stress_fs_pool" in
+  let cfg = Irmin_fs_unix.config ~root ~clock in
+  let repo = Store.Repo.v cfg in
+  let main = Store.main repo in
+  let info () = Store.Info.v 0L in
+  let worker id () =
+    for i = 1 to iter do
+      Store.set_exn ~info main [ Printf.sprintf "k-%d-%d" id i ] "v"
+    done
+  in
+  let fns = List.init 2 (fun id -> worker id) in
+  Stress_common.domains_run ~dmgr fns;
+  Store.Repo.close repo

test/irmin-pack/test_tsan_stress/stress_mem_cache.ml

@@ -0,0 +1,23 @@
+(* Races the global [cache : (string, _) Hashtbl.t] captured by
+   [Irmin_mem.Read_only.v] in src/irmin/mem/irmin_mem.ml:44.
+
+   N domains barrier-start, then each opens and closes a Repo.v
+   repeatedly. On cold cache they all race on Hashtbl.find_opt/add;
+   after that, set_exn on the shared repo races the mutable KMap field
+   of the underlying Read_only instance. *)
+
+module Store = Irmin_mem.KV.Make (Irmin.Contents.String)
+
+let run ~env ~iter =
+  let dmgr = Eio.Stdenv.domain_mgr env in
+  let info () = Store.Info.v 0L in
+  let worker id () =
+    for i = 1 to iter do
+      let repo = Store.Repo.v (Irmin_mem.config ()) in
+      let main = Store.main repo in
+      Store.set_exn ~info main [ Printf.sprintf "k-%d-%d" id i ] "v";
+      Store.Repo.close repo
+    done
+  in
+  let fns = List.init 4 (fun id -> worker id) in
+  Stress_common.domains_run ~dmgr fns

test/irmin-pack/test_tsan_stress/stress_watch.ml

@@ -0,0 +1,15 @@
+(* Races the global [listen_dir_hook] / [watch_switch] refs in
+   src/irmin/watch.ml:28-29. N domains concurrently overwrite the
+   shared hook with [set_listen_dir_hook]; the assignment to the
+   [ref] is unsynchronised. *)
+
+let dummy_hook _ _ _ _ = ()
+
+let run ~env ~iter =
+  let dmgr = Eio.Stdenv.domain_mgr env in
+  let worker () =
+    for _ = 1 to iter do
+      Irmin.Backend.Watch.set_listen_dir_hook dummy_hook
+    done
+  in
+  Stress_common.domains_spawn ~dmgr ~nb:4 worker