Skip to content

Commit

Permalink
Shrink: decompose Shrink.list into Shrink.list_spine and Shrink.list_…
Browse files Browse the repository at this point in the history
…elems
  • Loading branch information
gasche authored and c-cube committed Jul 13, 2019
1 parent 724e878 commit e3076e4
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 11 deletions.
28 changes: 17 additions & 11 deletions src/core/QCheck.ml
Original file line number Diff line number Diff line change
Expand Up @@ -333,6 +333,7 @@ module Shrink = struct
type 'a t = 'a -> 'a Iter.t

let nil _ = Iter.empty

let unit = nil

(* balanced shrinker for integers (non-exhaustive) *)
Expand Down Expand Up @@ -394,7 +395,7 @@ module Shrink = struct
)
done

let list ?shrink l yield =
let list_spine l yield =
let n = List.length l in
let chunk_size = ref (n/2) in

Expand Down Expand Up @@ -424,18 +425,23 @@ module Shrink = struct
in
pos_loop [] l';
chunk_size := !chunk_size / 2;
done;
done

let list_elems shrink l yield =
(* try to shrink each element of the list *)
let rec elem_loop rev_prefix suffix = match suffix with
| [] -> ()
| x::xs ->
shrink x (fun x' -> yield (List.rev_append rev_prefix (x'::xs)));
elem_loop (x::rev_prefix) xs
in
elem_loop [] l

let list ?shrink l yield =
list_spine l yield;
match shrink with
| None -> ()
| Some f ->
(* try to shrink each element of the list *)
let rec elem_loop rev_prefix suffix = match suffix with
| [] -> ()
| x::xs ->
f x (fun x' -> yield (List.rev_append rev_prefix (x'::xs)));
elem_loop (x::rev_prefix) xs
in
elem_loop [] l
| Some shrink -> list_elems shrink l yield

let pair a b (x,y) yield =
a x (fun x' -> yield (x',y));
Expand Down
6 changes: 6 additions & 0 deletions src/core/QCheck.mli
Original file line number Diff line number Diff line change
Expand Up @@ -467,6 +467,12 @@ module Shrink : sig
the elements of the list themselves (e.g. in an [int list]
one can try to decrease the integers). *)

val list_spine : 'a list t
(** Try to shrink lists by removing one or more elements. *)

val list_elems : 'a t -> 'a list t
(** Shrinks the elements of a list, without changing the list size. *)

val array : ?shrink:'a t -> 'a array t
(** Shrink an array.
@param shrink see {!list} *)
Expand Down

0 comments on commit e3076e4

Please sign in to comment.