TQueue: Allow some tasks to be saved when clearing a TQueue

1 files changed, 12 insertions, 0 deletions

diff --git a/stm/tQueue.ml b/stm/tQueue.ml
index 2a43cd7d13..2dad962bec 100644
--- a/stm/tQueue.ml
+++ b/stm/tQueue.ml
@@ -105,6 +105,18 @@ let clear { queue = q; lock = m; cond = c } =
   PriorityQueue.clear q;
   Mutex.unlock m
 
+let clear_saving { queue = q; lock = m; cond = c } f =
+  Mutex.lock m;
+  let saved = ref [] in
+  while not (PriorityQueue.is_empty q) do
+    let elem = PriorityQueue.pop q in
+    match f elem with
+    | Some x -> saved := x :: !saved
+    | None -> ()
+  done;
+  Mutex.unlock m;
+  List.rev !saved
+
 let is_empty { queue = q } = PriorityQueue.is_empty q
 
 let destroy tq =