From ff58dc0b5fc056ee03bd0a1474a228676b198d95 Mon Sep 17 00:00:00 2001 From: Fabian Date: Thu, 8 Nov 2018 17:35:13 -0600 Subject: [PATCH] Fix #235 for `CCRingBuffer` * Make dummy available to MakeFromArray * Overwrite deleted elements with a dummy element to allow them to be GCed * Test that deleted elements can be GCed --- src/data/CCRingBuffer.ml | 86 +++++++++++++++++++++++++++------------ src/data/CCRingBuffer.mli | 6 ++- 2 files changed, 65 insertions(+), 27 deletions(-) diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml index dc5cc173..4970b480 100644 --- a/src/data/CCRingBuffer.ml +++ b/src/data/CCRingBuffer.ml @@ -18,6 +18,10 @@ module Array = struct (** The type of an array instance *) type t + val dummy : elt + (** A dummy element used for empty slots in the array + @since NEXT_RELEASE *) + val create : int -> t (** Make an array of the given size, filled with dummy elements *) @@ -49,6 +53,7 @@ module Array = struct module Byte : S with type elt = char and type t = Bytes.t = struct type elt = char + let dummy = '\x00' include Bytes end @@ -56,6 +61,7 @@ module Array = struct S with type elt = Elt.t and type t = Elt.t array = struct type elt = Elt.t type t = Elt.t array + let dummy = Elt.dummy let create size = Array.make size Elt.dummy let length = Array.length let get = Array.get @@ -339,20 +345,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct to_buf = s && len = Bytes.length s) *) - let clear b = - b.stop <- 0; - b.start <- 0; - () - - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - Byte.clear b; \ - Byte.length b = 0) - *) - let is_empty b = b.start = b.stop (*$Q @@ -367,6 +359,7 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let take_front_exn b = if b.start = b.stop then raise Empty; let c = A.get b.buf b.start in + A.set b.buf b.start A.dummy; b.start <- next_ b b.start; c @@ -386,7 +379,9 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct if b.stop = 0 then b.stop <- A.length b.buf - 1 else b.stop <- b.stop - 1; - A.get b.buf b.stop + let c = A.get b.buf b.stop in + A.set b.buf b.stop A.dummy; + c let take_back b = try Some (take_back_exn b) with Empty -> None @@ -402,6 +397,7 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let junk_front b = if b.start = b.stop then raise Empty; + A.set b.buf b.start A.dummy; if b.start + 1 = A.length b.buf then b.start <- 0 else b.start <- b.start + 1 @@ -418,8 +414,9 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let junk_back b = if b.start = b.stop then raise Empty; if b.stop = 0 - then b.stop <- A.length b.buf - 1 - else b.stop <- b.stop - 1 + then b.stop <- A.length b.buf - 1 + else b.stop <- b.stop - 1; + A.set b.buf b.stop A.dummy (*$Q a_str (fun s -> let s = Bytes.of_string s in \ @@ -434,15 +431,9 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct if len > length b then ( invalid_arg "CCRingBuffer.skip"; ); - if b.stop >= b.start then ( - b.start <- b.start + len; - assert (b.stop >= b.start); - ) else ( - let len_end = A.length b.buf - b.start in - if len >= len_end - then b.start <- len-len_end (* wrap to the beginning *) - else b.start <- b.start + len - ) + for _ = 1 to len do + junk_front b + done (*$Q (Q.pair a_str a_str) (fun (s,s') -> \ @@ -456,6 +447,19 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct Byte.length b + l' = l) *) + let clear b = + skip b (length b) + + (*$Q + a_str (fun s -> let s = Bytes.of_string s in \ + let s_len = Bytes.length s in \ + let b = Byte.create (max s_len 64) in \ + Byte.blit_from b s 0 s_len; \ + Byte.clear b; \ + Byte.length b = 0) + *) + + let iter b ~f = if b.stop >= b.start then for i = b.start to b.stop - 1 do f (A.get b.buf i) done @@ -820,3 +824,33 @@ module Make(Elt:sig let l2 = CCList.filter_map (L_impl.apply_op l) ops in l1=l2 && BS.to_list b = L_impl.to_list l) *) + +(* check that deleted elements can be GCed *) +(*$inject + module BO = CCRingBuffer.Make(struct type t = int option let dummy=None end) + let make_bo () = + let b = BO.create 1000 in + for i = 1 to BO.capacity b do + BO.push_back b (Some i) + done; + b + let test_no_major_blocks clear = + Gc.full_major (); + let live_blocks_before = (Gc.stat ()).live_blocks in + let b = make_bo () in + clear b; + Gc.full_major (); + let live_blocks_after = (Gc.stat ()).live_blocks in + assert (BO.length b = 0); + let diff = live_blocks_after - live_blocks_before in + diff < BO.capacity b / 2 +*) + +(*$T + test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_front b; done) + test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_back b; done) + test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_front b); done) + test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_back b); done) + test_no_major_blocks (fun b -> BO.skip b (BO.length b)) + test_no_major_blocks (fun b -> BO.clear b) +*) diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli index a8384e37..bb2b4f2f 100644 --- a/src/data/CCRingBuffer.mli +++ b/src/data/CCRingBuffer.mli @@ -26,6 +26,10 @@ module Array : sig (** The type of an array instance *) type t + val dummy : elt + (** A dummy element used for empty slots in the array + @since NEXT_RELEASE *) + val create : int -> t (** Make an array of the given size, filled with dummy elements. *) @@ -117,7 +121,7 @@ module type S = sig (** Extract the current content into a list. *) val clear : t -> unit - (** Clear the content of the buffer. Doesn't actually destroy the content. *) + (** Clear the content of the buffer *) val is_empty :t -> bool (** Is the buffer empty (i.e. contains no elements)? *)