From 56fe3b087391c9bf8b7c600e84054ecd565ca2e5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 13 Jun 2014 22:30:41 +0200 Subject: [PATCH] remove Qcheck (it has had its own repo for a long time) --- _oasis | 2 +- misc/qCheck.ml | 335 ------------------------------------------------ misc/qCheck.mli | 267 -------------------------------------- 3 files changed, 1 insertion(+), 603 deletions(-) delete mode 100644 misc/qCheck.ml delete mode 100644 misc/qCheck.mli diff --git a/_oasis b/_oasis index 7eafd834..6251d22a 100644 --- a/_oasis +++ b/_oasis @@ -59,7 +59,7 @@ Library "containers_misc" PHashtbl, SkipList, SplayTree, SplayMap, Univ, Bij, PiCalculus, Bencode, Sexp, RAL, UnionFind, SmallSet, AbsSet, CSM, - ActionMan, QCheck, BencodeOnDisk, TTree, + ActionMan, BencodeOnDisk, TTree, HGraph, Automaton, Conv, Bidir, Iteratee, Ty, Tell, BencodeStream, RatTerm, Cause, AVL, ParseReact BuildDepends: unix,containers diff --git a/misc/qCheck.ml b/misc/qCheck.ml deleted file mode 100644 index b971ad7f..00000000 --- a/misc/qCheck.ml +++ /dev/null @@ -1,335 +0,0 @@ - -(* -copyright (c) 2013, simon cruanes -all rights reserved. - -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -*) - -(** {6 Quickcheck inspired property-based testing} *) - -module Arbitrary = struct - type 'a t = Random.State.t -> 'a - - let return x st = x - - let int n st = Random.State.int st n - - let int_range ~start ~stop st = - let n = stop - start in - if n <= 0 - then 0 - else start + Random.State.int st n - - let (--) start stop = int_range ~start ~stop - - let small_int = int 100 - - let split_int gen st = - let n = gen st in - if n > 0 - then let i = Random.State.int st (n+1) in i, n-i - else 0, 0 - - let bool = Random.State.bool - - let float f st = Random.State.float st f - - let char st = Char.chr (Random.State.int st 128) - - let alpha st = - Char.chr (Char.code 'a' + Random.State.int st (Char.code 'z' - Char.code 'a')) - - let string_len len st = - let n = len st in - assert (n>=0); - let s = String.create n in - for i = 0 to n-1 do - s.[i] <- alpha st - done; - s - - let string st = string_len (int 10) st - - let map ar f st = f (ar st) - - let rec _make_list ar st acc n = - if n = 0 then acc else - let x = ar st in - _make_list ar st (x::acc) (n-1) - - let list ?(len=int 10) ar st = - let n = len st in - _make_list ar st [] n - - let opt ar st = - if Random.State.bool st - then Some (ar st) - else None - - let list_repeat len ar st = - _make_list ar st [] len - - let array ?(len=int 10) ar st = - let n = len st in - Array.init n (fun _ -> ar st) - - let array_repeat n ar st = - Array.init n (fun _ -> ar st) - - let among_array a st = - if Array.length a < 1 - then failwith "Arbitrary.among: cannot choose in empty array "; - let i = Random.State.int st (Array.length a) in - a.(i) - - let among l = - if List.length l < 1 - then failwith "Arbitrary.among: cannot choose in empty list"; - among_array (Array.of_list l) - - let choose l = match l with - | [] -> failwith "cannot choose from empty list" - | [x] -> x - | _ -> - let a = Array.of_list l in - fun st -> - let i = Random.State.int st (Array.length a) in - a.(i) st - - let fix ?(max=15) ~base f = - let rec ar = lazy - (fun depth st -> - if depth >= max || Random.State.int st max < depth - then base st (* base case. THe deeper, the more likely. *) - else (* recurse *) - let ar' = Lazy.force ar (depth+1) in - f ar' st) - in - Lazy.force ar 0 - - let fix_depth ~depth ~base f st = - let max = depth st in - fix ~max ~base f st - - let rec retry gen st = match gen st with - | None -> retry gen st - | Some x -> x - - let lift f a st = f (a st) - - let lift2 f a b st = f (a st) (b st) - - let lift3 f a b c st = f (a st) (b st) (c st) - - let lift4 f a b c d st = f (a st) (b st) (c st) (d st) - - let pair a b = lift2 (fun x y -> x,y) a b - - let triple a b c = lift3 (fun x y z -> x,y,z) a b c - - let quad a b c d = lift4 (fun x y z w -> x,y,z,w) a b c d - - let (>>=) a f st = - let x = a st in - f x st - - let generate ?(n=100) ?(rand=Random.State.make_self_init()) gen = - let l = ref [] in - for i = 0 to n-1 do - l := (gen rand) :: !l - done; - !l -end - -(** {2 Pretty printing} *) - -module PP = struct - type 'a t = 'a -> string - - let int = string_of_int - let bool = string_of_bool - let float = string_of_float - let string s = s - let char c = - let s = "_" in - s.[0] <- c; - s - - let pair a b (x,y) = Printf.sprintf "(%s, %s)" (a x) (b y) - let triple a b c (x,y,z) = Printf.sprintf "(%s, %s, %s)" (a x) (b y) (c z) - let quad a b c d (x,y,z,w) = - Printf.sprintf "(%s, %s, %s, %s)" (a x) (b y) (c z) (d w) - - let list pp l = - let b = Buffer.create 25 in - Buffer.add_char b '['; - List.iteri (fun i x -> - if i > 0 then Buffer.add_string b ", "; - Buffer.add_string b (pp x)) - l; - Buffer.add_char b ']'; - Buffer.contents b - - let array pp a = - let b = Buffer.create 25 in - Buffer.add_string b "[|"; - Array.iteri (fun i x -> - if i > 0 then Buffer.add_string b ", "; - Buffer.add_string b (pp x)) - a; - Buffer.add_string b "|]"; - Buffer.contents b -end - -(** {2 Testing} *) - -module Prop = struct - type 'a t = 'a -> bool - - exception PrecondFail - - let assume p = - if not p then raise PrecondFail - - let assume_lazy (lazy p) = - if not p then raise PrecondFail - - let (==>) a b = - fun x -> - assume (a x); - b x - - let (&&&) a b x = a x && b x - - let (|||) a b x = a x || b x - - let (!!!) a x = not (a x) -end - -type 'a result = - | Ok of int * int (* total number / precond failed *) - | Failed of 'a list - | Error of 'a option * exn - -(* random seed, for repeatability of tests *) -let __seed = [| 89809344; 994326685; 290180182 |] - -let check ?(rand=Random.State.make __seed) ?(n=100) gen prop = - let precond_failed = ref 0 in - let failures = ref [] in - let inst = ref None in - try - for i = 0 to n - 1 do - let x = gen rand in - inst := Some x; - try - if not (prop x) - then failures := x :: !failures - with Prop.PrecondFail -> - incr precond_failed - done; - match !failures with - | [] -> Ok (n, !precond_failed) - | _ -> Failed (!failures) - with e -> - Error (!inst, e) - -(** {2 Main} *) - -type 'a test_cell = { - n : int; - pp : 'a PP.t option; - prop : 'a Prop.t; - gen : 'a Arbitrary.t; - name : string; - limit : int; - size : ('a -> int) option; -} -type test = - | Test : 'a test_cell -> test - (** GADT needed for the existential type *) - -let mk_test ?(n=100) ?pp ?(name="") ?size ?(limit=10) gen prop = - if limit < 0 then failwith "QCheck: limit needs be >= 0"; - if n <= 0 then failwith "QCheck: n needs be >= 0"; - Test { prop; gen; name; n; pp; size; limit; } - -(* tail call version of take, that returns (at most) [n] elements of [l] *) -let rec _list_take acc l n = match l, n with - | _, 0 - | [], _ -> List.rev acc - | x::l', _ -> _list_take (x::acc) l' (n-1) - -let run ?(out=stdout) ?(rand=Random.State.make __seed) (Test test) = - Printf.fprintf out "testing property %s...\n" test.name; - match check ~rand ~n:test.n test.gen test.prop with - | Ok (n, prefail) -> - Printf.fprintf out " [✔] passed %d tests (%d preconditions failed)\n" n prefail; - true - | Failed l -> - begin match test.pp with - | None -> Printf.fprintf out " [×] %d failures over %d\n" (List.length l) test.n - | Some pp -> - Printf.fprintf out " [×] %d failures over %d (print at most %d):\n" - (List.length l) test.n test.limit; - let to_print = match test.size with - | None -> l - | Some size -> - (* sort by increasing size *) - let l = List.map (fun x -> x, size x) l in - let l = List.sort (fun (x,sx) (y,sy) -> sx - sy) l in - List.map fst l - in - (* only keep [limit] counter examples *) - let to_print = _list_take [] to_print test.limit in - (* print the counter examples *) - List.iter - (fun x -> Printf.fprintf out " %s\n" (pp x)) - to_print - end; - false - | Error (inst, e) -> - begin match inst, test.pp with - | _, None - | None, _ -> Printf.fprintf out " [×] error: %s\n" (Printexc.to_string e); - | Some x, Some pp -> - (* print instance on which the error occurred *) - Printf.fprintf out " [×] error on instance %s: %s\n" - (pp x) (Printexc.to_string e); - end; - false - -type suite = test list - -let flatten = List.flatten - -let run_tests ?(out=stdout) ?(rand=Random.State.make __seed) l = - let start = Unix.gettimeofday () in - let n = List.length l in - let failed = ref 0 in - Printf.fprintf out "check %d properties...\n" (List.length l); - List.iter (fun test -> if not (run ~out ~rand test) then incr failed) l; - Printf.fprintf out "tests run in %.2fs\n" (Unix.gettimeofday() -. start); - if !failed = 0 - then Printf.fprintf out "[✔] Success! (passed %d tests)\n" n - else Printf.fprintf out "[×] Failure. (%d tests failed over %d)\n" !failed n; - !failed = 0 diff --git a/misc/qCheck.mli b/misc/qCheck.mli deleted file mode 100644 index 7c3c006e..00000000 --- a/misc/qCheck.mli +++ /dev/null @@ -1,267 +0,0 @@ - -(* -copyright (c) 2013, simon cruanes -all rights reserved. - -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -*) - -(** {1 Quickcheck inspired property-based testing} *) - -(** The library takes inspiration from Haskell's QuickCheck library. The -rough idea is that the programer describes invariants that values of -a certain type need to satisfy ("properties"), as functions from this type -to bool. She also needs to desribe how to generate random values of the type, -so that the property is tried and checked on a number of random instances. - -This explains the organization of this module: - -- {! Arbitrary} is used to describe how to generate random values. An - ['a Arbitrary.t] is a random generator of values of type 'a. -- {! Prop} is used to describe and combine properties. Especially interesting - is [Prop.(==>)], that is such that [a ==> b] only checks the property [b] - on a value [x] if [a x] holds (precondition). -- {! PP} describes a few combinators to print values. This is used when a - property fails on some instances, to print the failing instances. - -Then, a few functions are provided to test properties. Optional parameters -allow to specify the random generator, the printer for failing cases, the -number of instances to generate and test... - - -Examples: - - - List.rev is involutive: - -{[ -let test = QCheck.mk_test ~n:1000 QCheck.Arbitrary.(list alpha) - (fun l -> List.rev (List.rev l) = l);; -QCheck.run test;; -]} - - Not all lists are sorted (false property that will fail. The 15 smallest - counter-example lists will be printed): - -{[ -let test = QCheck.( - mk_test - ~n:10_000 ~size:List.length ~limit:15 ~pp:QCheck.PP.(list int) - QCheck.Arbitrary.(list small_int) - (fun l -> l = List.sort compare l));; -QCheck.run test;; -]} - - - - generate 20 random trees using {! Arbitrary.fix} : - -{[type tree = Int of int | Node of tree list;; - - let ar = QCheck.Arbitrary.(fix ~max:10 - ~base:(map small_int (fun i -> Int i)) - (fun t st -> Node (list t st)));; - - Arbitrary.generate ~n:20 ar;; - ]} -*) - -(** {2 Description of how to generate arbitrary values for some type} *) - -module Arbitrary : sig - type 'a t = Random.State.t -> 'a - (** A generator of arbitrary values of type 'a *) - - val return : 'a -> 'a t - (** Return always the same value (e.g. [4]) *) - - val int : int -> int t - (** Any integer between 0 (inclusive) and the given higher bound (exclusive) *) - - val int_range : start:int -> stop:int -> int t - (* Integer range start .. stop-1 *) - - val (--) : int -> int -> int t - (** Infix synonym for {!int_range} *) - - val small_int : int t - (** Ints lower than 100 *) - - val split_int : int t -> (int * int) t - (** [split_int gen] generates a number [n] from [gen], and - returns [i, j] where [i + j = n] *) - - val bool : bool t - (** Arbitrary boolean *) - - val char : char t - (** A (printable) char *) - - val alpha : char t - (** Alphabetic char *) - - val float : float -> float t - (** Random float *) - - val string : string t - (** Random strings of small length *) - - val string_len : int t -> string t - (** String of random length *) - - val map : 'a t -> ('a -> 'b) -> 'b t - (** Transform an arbitrary into another *) - - val list : ?len:int t -> 'a t -> 'a list t - (** List of arbitrary length. Default [len] is between 0 and 10. *) - - val opt : 'a t -> 'a option t - (** May return a value, or None *) - - val pair : 'a t -> 'b t -> ('a * 'b) t - - val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t - - val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t - - val list_repeat : int -> 'a t -> 'a list t - (** Lists of given length exactly *) - - val array : ?len:int t -> 'a t -> 'a array t - (** Random array of random length *) - - val array_repeat : int -> 'a t -> 'a array t - (** Random array of given length *) - - val among : 'a list -> 'a t - (** Choose an element among those of the list *) - - val among_array : 'a array -> 'a t - (** Choose in the array *) - - val choose : 'a t list -> 'a t - (** Choice among combinations *) - - val fix : ?max:int -> base:'a t -> ('a t -> 'a t) -> 'a t - (** Recursive arbitrary values. The optional value [max] defines - the maximal depth, if needed (default 15). [base] is the base case. *) - - val fix_depth : depth:int t -> base:'a t -> ('a t -> 'a t) -> 'a t - (** Recursive values of at most given random depth *) - - val lift : ('a -> 'b) -> 'a t -> 'b t - val lift2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val lift3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t - val lift4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t - - val (>>=) : 'a t -> ('a -> 'b t) -> 'b t - (** Monadic bind *) - - val retry : 'a option t -> 'a t - (** CCGenerate until a Some value is returned *) - - val generate : ?n:int -> ?rand:Random.State.t -> 'a t -> 'a list - (** CCGenerate [n] random values of the given type *) -end - -(** {2 Pretty printing} *) - -module PP : sig - type 'a t = 'a -> string - - val int : int t - val bool : bool t - val float : float t - val char : char t - val string : string t - - val pair : 'a t -> 'b t -> ('a*'b) t - val triple : 'a t -> 'b t -> 'c t -> ('a*'b*'c) t - val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a*'b*'c*'d) t - - val list : 'a t -> 'a list t - val array : 'a t -> 'a array t -end - -(** {2 Testing} *) - -module Prop : sig - type 'a t = 'a -> bool - - val (==>) : ('a -> bool) -> 'a t -> 'a t - (** Precondition for a test *) - - val assume : bool -> unit - (** Assume the given precondition holds. A test won't fail if the - precondition (the boolean argument) is false, but it will be - discarded. Running tests counts how many instances were - discarded for not satisfying preconditions. *) - - val assume_lazy : bool lazy_t -> unit - (** Assume the given (lazy) precondition holds. See {!assume}. *) - - val (&&&) : 'a t -> 'a t -> 'a t - (** Logical 'and' on tests *) - - val (|||) : 'a t -> 'a t -> 'a t - (** Logical 'or' on tests *) - - val (!!!) : 'a t -> 'a t - (** Logical 'not' on tests *) -end - -type 'a result = - | Ok of int * int (** total number of tests / number of failed preconditions *) - | Failed of 'a list (** Failed instances *) - | Error of 'a option * exn (** Error, and possibly instance that triggered it *) - -val check : ?rand:Random.State.t -> ?n:int -> - 'a Arbitrary.t -> 'a Prop.t -> 'a result - (** Check that the property [prop] holds on [n] random instances of the type - 'a, as generated by the arbitrary instance [gen] *) - -(** {2 Main} *) - -type test - (** A single property test *) - -val mk_test : ?n:int -> ?pp:'a PP.t -> ?name:string -> - ?size:('a -> int) -> ?limit:int -> - 'a Arbitrary.t -> 'a Prop.t -> test - (** Construct a test. Optional parameters are the same as for {!run}. - @param name is the name of the property that is checked - @param pp is a pretty printer for failing instances - @out is the channel to print results onto - @n is the number of tests (default 100) - @rand is the random generator to use - @size is a size function on values on which tests are performed. If - the test fails and a size function is given, the smallest - counter-examples with respect to [size] will be printed in priority. - @limit maximal number of counter-examples that will get printed. - Default is [10]. *) - -val run : ?out:out_channel -> ?rand:Random.State.t -> test -> bool - (** Run a test and print results *) - -type suite = test list - (** A test suite is a list of tests *) - -val flatten : suite list -> suite - -val run_tests : ?out:out_channel -> ?rand:Random.State.t -> suite -> bool - (** Run a suite of tests, and print its results *)