aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorGravatar Alec Faithfull <alef@itu.dk>2015-10-06 14:19:34 +0200
committerGravatar Enrico Tassi <Enrico.Tassi@inria.fr>2015-10-09 11:01:43 +0200
commit56ca108e63191e90c3d4169c37a4c97017e3c6ae (patch)
tree7f2e6e23ed8093d43ec3179980dcfaf5464eebc1
parentce0c536b4430711db1e30cd7ac35ae8d71d34e64 (diff)
TQueue: Expose the length of TQueues
-rw-r--r--stm/tQueue.ml8
-rw-r--r--stm/tQueue.mli2
2 files changed, 10 insertions, 0 deletions
diff --git a/stm/tQueue.ml b/stm/tQueue.ml
index 6fef895ae..2a43cd7d1 100644
--- a/stm/tQueue.ml
+++ b/stm/tQueue.ml
@@ -15,6 +15,7 @@ module PriorityQueue : sig
val pop : ?picky:('a -> bool) -> 'a t -> 'a
val push : 'a t -> 'a -> unit
val clear : 'a t -> unit
+ val length : 'a t -> int
end = struct
type 'a item = int * 'a
type 'a rel = 'a item -> 'a item -> int
@@ -38,6 +39,7 @@ end = struct
let set_rel rel ({ contents = (xs, _) } as t) =
let rel (_,x) (_,y) = rel x y in
t := (List.sort rel xs, rel)
+ let length ({ contents = (l, _) }) = List.length l
end
type 'a t = {
@@ -92,6 +94,12 @@ let push { queue = q; lock = m; cond = c; release } x =
Condition.broadcast c;
Mutex.unlock m
+let length { queue = q; lock = m } =
+ Mutex.lock m;
+ let n = PriorityQueue.length q in
+ Mutex.unlock m;
+ n
+
let clear { queue = q; lock = m; cond = c } =
Mutex.lock m;
PriorityQueue.clear q;
diff --git a/stm/tQueue.mli b/stm/tQueue.mli
index 7458de510..f54af4df4 100644
--- a/stm/tQueue.mli
+++ b/stm/tQueue.mli
@@ -28,3 +28,5 @@ exception BeingDestroyed
(* Threads blocked in pop can get this exception if the queue is being
* destroyed *)
val destroy : 'a t -> unit
+
+val length : 'a t -> int