@@ -80,7 +80,8 @@ module type S = sig
80
80
val create : int -> t
81
81
(* * [create size] creates a new bounded buffer with given size.
82
82
The underlying array is allocated immediately and no further (large)
83
- allocation will happen from now on. *)
83
+ allocation will happen from now on.
84
+ @raise Invalid_argument if the arguments is [< 1] *)
84
85
85
86
val copy : t -> t
86
87
(* * Make a fresh copy of the buffer. *)
@@ -91,6 +92,10 @@ module type S = sig
91
92
val length : t -> int
92
93
(* * Number of elements currently stored in the buffer. *)
93
94
95
+ val is_full : t -> bool
96
+ (* * true if pushing an element would erase another element.
97
+ @since NEXT_RELEASE *)
98
+
94
99
val blit_from : t -> Array .t -> int -> int -> unit
95
100
(* * [blit_from buf from_buf o len] copies the slice [o, ... o + len - 1] from
96
101
a input buffer [from_buf] to the end of the buffer.
@@ -152,25 +157,25 @@ module type S = sig
152
157
otherwise the oldest elements are replaced first. *)
153
158
154
159
val peek_front : t -> Array .elt
155
- (* * First value from front of [t].
160
+ (* * First value from front of [t], without modification .
156
161
@raise Empty if buffer is empty. *)
157
162
158
163
val peek_back : t -> Array .elt
159
- (* * Get the last value from back of [t].
164
+ (* * Get the last value from back of [t], without modification .
160
165
@raise Empty if buffer is empty. *)
161
166
162
167
val take_back : t -> Array .elt option
163
- (* * Take the last value from back of [t], if any *)
168
+ (* * Take and remove the last value from back of [t], if any *)
164
169
165
170
val take_back_exn : t -> Array .elt
166
- (* * Take the last value from back of [t].
171
+ (* * Take and remove the last value from back of [t].
167
172
@raise Empty if buffer is already empty. *)
168
173
169
174
val take_front : t -> Array .elt option
170
- (* * Take the first value from front of [t], if any *)
175
+ (* * Take and remove the first value from front of [t], if any *)
171
176
172
177
val take_front_exn : t -> Array .elt
173
- (* * Take the first value from front of [t].
178
+ (* * Take and remove the first value from front of [t].
174
179
@raise Empty if buffer is already empty. *)
175
180
176
181
val of_array : Array .t -> t
@@ -235,6 +240,8 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct
235
240
then b.stop - b.start
236
241
else (A. length b.buf - b.start) + b.stop
237
242
243
+ let is_full b = length b + 1 = Array. length b.buf
244
+
238
245
let next_ b i =
239
246
let j = i+ 1 in
240
247
if j = A. length b.buf then 0 else j
@@ -629,6 +636,7 @@ type op =
629
636
| Junk_back
630
637
| Skip of int
631
638
| Blit of string * int * int
639
+ | Z_if_full
632
640
633
641
let str_of_op = function
634
642
| Push_back c -> Printf.sprintf "push_back(%C)" c
@@ -638,6 +646,7 @@ let str_of_op = function
638
646
| Junk_back -> Printf.sprintf "junk_back"
639
647
| Skip n -> Printf.sprintf "skip(%d)" n
640
648
| Blit (s,i,len) -> Printf.sprintf "blit(%S,%d,%d)" s i len
649
+ | Z_if_full -> "zero_if_full"
641
650
642
651
let push_back c = Push_back c
643
652
let skip n = assert (n>=0); Skip n
@@ -651,7 +660,9 @@ let shrink_op =
651
660
let open Q.Iter in
652
661
function
653
662
| Push_back c -> Q.Shrink.char c >|= push_back
654
- | Take_front | Take_back | Junk_back | Junk_front -> empty
663
+ | Take_front | Take_back | Junk_back | Junk_front
664
+ | Z_if_full
665
+ -> empty
655
666
| Skip n -> Q.Shrink.int n >|= skip
656
667
| Blit (s,i,len) ->
657
668
let s_i =
@@ -672,6 +683,7 @@ let rec len_op size acc = function
672
683
| Push_back _ -> min size (acc + 1)
673
684
| Take_front | Take_back | Junk_front | Junk_back -> max (acc-1) 0
674
685
| Skip n -> if acc >= n then acc-n else acc
686
+ | Z_if_full -> acc
675
687
| Blit (_,_,len) -> min size (acc + len)
676
688
677
689
let apply_op b = function
@@ -684,6 +696,7 @@ let apply_op b = function
684
696
| Blit (s,i,len) ->
685
697
assert(i+len <= String.length s);
686
698
BS.blit_from b (Bytes.unsafe_of_string s) i len; None
699
+ | Z_if_full -> if BS.is_full b then Some '0' else None
687
700
688
701
let gen_op =
689
702
let open Q.Gen in
@@ -702,6 +715,7 @@ let gen_op =
702
715
2, g_blit;
703
716
1, (0--5 >|= skip);
704
717
2, map push_back g_char;
718
+ 1, return Z_if_full;
705
719
]
706
720
707
721
let arb_op =
@@ -755,6 +769,7 @@ module L_impl = struct
755
769
| Junk_front -> junk_front b; None
756
770
| Skip n -> skip b n; None
757
771
| Blit (s,i,len) -> blit b s i len; None
772
+ | Z_if_full -> if b.size = List.length b.l then Some '0' else None
758
773
759
774
let to_list b = b.l
760
775
end
0 commit comments