From 444f8a3acc8ef1124307db219bc567c4fbc6bc73 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 26 Aug 2024 11:20:27 -0400
Subject: [PATCH] fix with actual TLS release

---
 src/private/thread_local_storage_.mli     |  6 ++++--
 src/private/thread_local_storage_.real.ml | 17 +++++++++++++----
 2 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/src/private/thread_local_storage_.mli b/src/private/thread_local_storage_.mli
index 16aea3dd..2769f4cd 100644
--- a/src/private/thread_local_storage_.mli
+++ b/src/private/thread_local_storage_.mli
@@ -4,10 +4,12 @@ type 'a t
 (** A TLS slot for values of type ['a]. This allows the storage of a
     single value of type ['a] per thread. *)
 
+exception Not_set
+
 val create : unit -> 'a t
 
-val get : 'a t -> 'a
-(** @raise Failure if not present *)
+val get_exn : 'a t -> 'a
+(** @raise Not_set if not present *)
 
 val get_opt : 'a t -> 'a option
 val set : 'a t -> 'a -> unit
diff --git a/src/private/thread_local_storage_.real.ml b/src/private/thread_local_storage_.real.ml
index 09411a06..870abd3f 100644
--- a/src/private/thread_local_storage_.real.ml
+++ b/src/private/thread_local_storage_.real.ml
@@ -62,15 +62,14 @@ let[@inline] get_raw index : Obj.t =
   else
     sentinel_value_for_uninit_tls
 
-let[@inline never] tls_error () =
-  failwith "Thread_local_storage.get: TLS entry not initialised"
+exception Not_set
 
-let[@inline] get slot =
+let[@inline] get_exn slot =
   let v = get_raw slot in
   if v != sentinel_value_for_uninit_tls then
     Obj.obj v
   else
-    tls_error ()
+    raise_notrace Not_set
 
 let[@inline] get_opt slot =
   let v = get_raw slot in
@@ -109,3 +108,13 @@ let get_tls_with_capacity index : Obj.t array =
 let[@inline] set slot value : unit =
   let tls = get_tls_with_capacity slot in
   Array.unsafe_set tls slot (Obj.repr (Sys.opaque_identity value))
+
+let[@inline] get_default ~default slot =
+  let v = get_raw slot in
+  if v != sentinel_value_for_uninit_tls then
+    Obj.obj v
+  else (
+    let v = default () in
+    set slot v;
+    v
+  )