From 20bc02a379ee8020f0d49f705b88e838811f3b1d Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Mon, 18 Jan 2021 00:19:55 +0000 Subject: [PATCH 1/5] Remove backward pipe --- doc/tutorial.md | 36 +++---- src/Hedgehog/Gen.fs | 137 ++++++++++++++------------- src/Hedgehog/Property.fs | 32 ++++--- src/Hedgehog/Random.fs | 43 ++++----- src/Hedgehog/Script.fsx | 96 +++++++++---------- src/Hedgehog/Shrink.fs | 8 +- tests/Hedgehog.Benchmarks/Program.fs | 26 ++--- tests/Hedgehog.Tests/GenTests.fs | 14 +-- tests/Hedgehog.Tests/MinimalTests.fs | 23 ++--- tests/Hedgehog.Tests/RangeTests.fs | 54 +++++------ tests/Hedgehog.Tests/ShrinkTests.fs | 26 ++--- tests/Hedgehog.Tests/TreeTests.fs | 12 +-- 12 files changed, 260 insertions(+), 247 deletions(-) diff --git a/doc/tutorial.md b/doc/tutorial.md index 8c845e54..bddc7129 100644 --- a/doc/tutorial.md +++ b/doc/tutorial.md @@ -27,18 +27,18 @@ One way to use Hedgehog to check the above property is to use the `property` com ```fs property { - let! xs = Gen.list (Range.linear 0 100) <| Gen.int (Range.constant 0 1000) + let! xs = Gen.list (Range.linear 0 100) (Gen.int (Range.constant 0 1000)) return List.rev (List.rev xs) = xs - } +} ``` and to test the above property on 100 random lists of integers, pipe it into `Property.print`: ```fs property { - let! xs = Gen.list (Range.linear 0 100) <| Gen.int (Range.constant 0 1000) + let! xs = Gen.list (Range.linear 0 100) (Gen.int (Range.constant 0 1000)) return List.rev (List.rev xs) = xs - } +} |> Property.print +++ OK, passed 100 tests. @@ -251,10 +251,10 @@ let version = |> Gen.tuple3 |> Gen.map (fun (ma, mi, bu) -> Version (ma, mi, bu)) -Property.print <| property { +Property.print (property { let! xs = Gen.list (Range.linear 0 100) version return xs |> List.rev = xs - } +}) > *** Failed! Falsifiable (after 3 tests and 6 shrinks): @@ -277,7 +277,7 @@ let version = |> Arb.fromGen version -|> Prop.forAll <| fun xs -> xs |> List.rev = xs +|> Prop.forAll (fun xs -> xs |> List.rev = xs) |> Check.Quick > @@ -353,7 +353,7 @@ open System.Net let ipAddressGen : Gen = gen { - let! addr = Gen.array (Range.constant 4 4) (Gen.byte <| Range.constantBounded()) + let! addr = Gen.array (Range.singleton 4) (Gen.byte (Range.constantBounded ())) return System.Net.IPAddress addr } @@ -559,7 +559,7 @@ Hedgehog will then attempt to generate a test case that *falsifies* the assertio Values for `xs` need to be generated by a generator, as shown in the *Generators* sections. The following one is for lists of type integer: ```fs -let g = Gen.list (Range.linear 0 20) (Gen.int <| Range.constant 0 100);; +let g = Gen.list (Range.linear 0 20) (Gen.int (Range.constant 0 100));; val g : Gen ``` @@ -631,8 +631,8 @@ let tryAdd a b = if a > 100 then None // Nasty bug. else Some (a + b) -property { let! a = Gen.int <| Range.constantBounded () - let! b = Gen.int <| Range.constantBounded () +property { let! a = Gen.int (Range.constantBounded ()) + let! b = Gen.int (Range.constantBounded ()) return tryAdd a b = Some (a + b) } |> Property.print;; @@ -658,8 +658,8 @@ let tryAdd a b = if a > 100 then None // Nasty bug. else Some(a + b) -property { let! a = Gen.int <| Range.constantBounded () - let! b = Gen.int <| Range.constantBounded () +property { let! a = Gen.int (Range.constantBounded ()) + let! b = Gen.int (Range.constantBounded ()) counterexample (sprintf "The value of a was %d." a) return tryAdd a b = Some(a + b) } |> Property.print;; @@ -681,8 +681,8 @@ let tryAdd a b = if a > 100 then None // Nasty bug. else Some(a + b) -property { let! a = Gen.int <| Range.constantBounded () - let! b = Gen.int <| Range.constantBounded () +property { let! a = Gen.int (Range.constantBounded ()) + let! b = Gen.int (Range.constantBounded ()) where (a < 100) return tryAdd a b = Some(a + b) } |> Property.print;; @@ -754,8 +754,10 @@ Here's a way to use it: ```fs let pattern = "^http\://[a-zA-Z0-9\-\.]+\.[a-zA-Z]{2,3}(/\S*)?$" -Property.print <| property { let! s = fromRegex pattern - return matches s pattern } +Property.print (property { + let! s = fromRegex pattern + return matches s pattern +}) +++ OK, passed 100 tests. diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index dfd10f43..2ef41b77 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -31,21 +31,21 @@ module Gen = Tree.singleton x |> Random.constant |> ofRandom let private bindRandom (m : Random>) (k : 'a -> Random>) : Random> = - Hedgehog.Random <| fun seed0 size -> - let seed1, seed2 = - Seed.split seed0 + Hedgehog.Random (fun seed0 size -> + let seed1, seed2 = + Seed.split seed0 - let run (seed : Seed) (random : Random<'x>) : 'x = - Random.run seed size random + let run (seed : Seed) (random : Random<'x>) : 'x = + Random.run seed size random - Tree.bind (run seed1 m) (run seed2 << k) + Tree.bind (run seed1 m) (run seed2 << k)) let bind (m0 : Gen<'a>) (k0 : 'a -> Gen<'b>) : Gen<'b> = bindRandom (toRandom m0) (toRandom << k0) |> ofRandom let apply (gf : Gen<'a -> 'b>) (gx : Gen<'a>) : Gen<'b> = - bind gf <| fun f -> - bind gx <| (f >> constant) + bind gf (fun f -> + bind gx (f >> constant)) let mapRandom (f : Random> -> Random>) (g : Gen<'a>) : Gen<'b> = toRandom g |> f |> ofRandom @@ -57,22 +57,22 @@ module Gen = mapTree (Tree.map f) g let map2 (f : 'a -> 'b -> 'c) (gx : Gen<'a>) (gy : Gen<'b>) : Gen<'c> = - bind gx <| fun x -> - bind gy <| fun y -> - constant (f x y) + bind gx (fun x -> + bind gy (fun y -> + constant (f x y))) let map3 (f : 'a -> 'b -> 'c -> 'd) (gx : Gen<'a>) (gy : Gen<'b>) (gz : Gen<'c>) : Gen<'d> = - bind gx <| fun x -> - bind gy <| fun y -> - bind gz <| fun z -> - constant (f x y z) + bind gx (fun x -> + bind gy (fun y -> + bind gz (fun z -> + constant (f x y z)))) let map4 (f : 'a -> 'b -> 'c -> 'd -> 'e) (gx : Gen<'a>) (gy : Gen<'b>) (gz : Gen<'c>) (gw : Gen<'d>) : Gen<'e> = - bind gx <| fun x -> - bind gy <| fun y -> - bind gz <| fun z -> - bind gw <| fun w -> - constant (f x y z w) + bind gx (fun x -> + bind gy (fun y -> + bind gz (fun z -> + bind gw (fun w -> + constant (f x y z w))))) let zip (gx : Gen<'a>) (gy : Gen<'b>) : Gen<'a * 'b> = map2 (fun x y -> x, y) gx gy @@ -107,10 +107,10 @@ module Gen = bind m k member __.For(xs, k) = let xse = (xs :> seq<'a>).GetEnumerator () - using xse <| fun xse -> + using xse (fun xse -> let mv = xse.MoveNext let kc = delay (fun () -> k xse.Current) - loop mv kc + loop mv kc) member __.Combine(m, n) = bind m (fun () -> n) member __.Delay(f) = @@ -154,8 +154,8 @@ module Gen = /// Adjust the size parameter, by transforming it with the given /// function. let scale (f : int -> int) (g : Gen<'a>) : Gen<'a> = - sized <| fun n -> - resize (f n) g + sized (fun n -> + resize (f n) g) // // Combinators - Numeric @@ -163,7 +163,7 @@ module Gen = /// Generates a random number in the given inclusive range. let inline integral (range : Range<'a>) : Gen<'a> = - create (Shrink.towards <| Range.origin range) (Random.integral range) + create (Shrink.towards (Range.origin range)) (Random.integral range) // // Combinators - Choice @@ -179,7 +179,7 @@ module Gen = if Array.isEmpty xs then return crashEmpty "xs" else - let! ix = integral <| Range.constant 0 (Array.length xs - 1) + let! ix = integral (Range.constant 0 (Array.length xs - 1)) return Array.item ix xs } @@ -202,7 +202,7 @@ module Gen = else pick (n - k) ys - let! n = integral <| Range.constant 1 total + let! n = integral (Range.constant 1 total) return! pick n xs } @@ -213,7 +213,7 @@ module Gen = if Array.isEmpty xs then return crashEmpty "xs" xs else - let! ix = integral <| Range.constant 0 (Array.length xs - 1) + let! ix = integral (Range.constant 0 (Array.length xs - 1)) return! Array.item ix xs } @@ -223,12 +223,15 @@ module Gen = /// from the recursive list. /// The first argument (i.e. the non-recursive input list) must be non-empty. let choiceRec (nonrecs : seq>) (recs : seq>) : Gen<'a> = - sized <| fun n -> + sized (fun n -> if n <= 1 then choice nonrecs else - let halve x = x / 2 - choice <| Seq.append nonrecs (Seq.map (scale halve) recs) + recs + |> Seq.map (scale (fun x -> x / 2)) + |> Seq.append nonrecs + |> choice + ) // // Combinators - Conditional @@ -242,42 +245,45 @@ module Gen = Random.constant None | n -> let r = Random.resize (2 * k + n) r0 - Random.bind r <| fun x -> + Random.bind r (fun x -> if p (Tree.outcome x) then Tree.filter p x |> Some |> Random.constant else - tryN (k + 1) (n - 1) + tryN (k + 1) (n - 1)) Random.sized (tryN 0 << max 1) /// Generates a value that satisfies a predicate. let filter (p : 'a -> bool) (g : Gen<'a>) : Gen<'a> = let rec loop () = - Random.bind (toRandom g |> tryFilterRandom p) <| function + Random.bind (toRandom g |> tryFilterRandom p) (function | None -> - Random.sized <| fun n -> - Random.resize (n + 1) (Random.delay loop) + Random.sized (fun n -> + Random.resize (n + 1) (Random.delay loop)) | Some x -> - Random.constant x + Random.constant x) loop () |> ofRandom /// Tries to generate a value that satisfies a predicate. let tryFilter (p : 'a -> bool) (g : Gen<'a>) : Gen<'a option> = - ofRandom << Random.bind (toRandom g |> tryFilterRandom p) <| function + let filter = function | None -> - None |> Tree.singleton |> Random.constant + Random.constant (Tree.singleton None) | Some x -> - Tree.map Some x |> Random.constant + Random.constant (Tree.map Some x) + + let flipBind f ma = Random.bind ma f + + toRandom g + |> tryFilterRandom p + |> flipBind filter + |> ofRandom /// Runs an option generator until it produces a 'Some'. let some (g : Gen<'a option>) : Gen<'a> = - bind (filter Option.isSome g) <| function - | Some x -> - constant x - | None -> - invalidOp "internal error, unexpected None" + bind (filter Option.isSome g) (Option.get >> constant) // // Combinators - Collections @@ -285,25 +291,24 @@ module Gen = /// Generates a 'None' part of the time. let option (g : Gen<'a>) : Gen<'a option> = - sized <| fun n -> + sized (fun n -> frequency [ 2, constant None 1 + n, map Some g - ] + ]) let private atLeast (n : int) (xs : List<'a>) : bool = (List.length xs) >= n /// Generates a list using a 'Range' to determine the length. let list (range : Range) (g : Gen<'a>) : Gen> = - ofRandom - <| (Random.sized - <| fun size -> random { - let! k = Random.integral range - let! xs = Random.replicate k (toRandom g) - return Shrink.sequenceList xs - |> Tree.filter (atLeast (Range.lowerBound size range)) - }) + Random.sized (fun size -> random { + let! k = Random.integral range + let! xs = Random.replicate k (toRandom g) + return Shrink.sequenceList xs + |> Tree.filter (atLeast (Range.lowerBound size range)) + }) + |> ofRandom /// Generates an array using a 'Range' to determine the length. let array (range : Range) (g : Gen<'a>) : Gen> = @@ -319,7 +324,9 @@ module Gen = // Generates a random character in the specified range. let char (lo : char) (hi : char) : Gen = - integral <| Range.constant (int lo) (int hi) |> map char + Range.constant (int lo) (int hi) + |> integral + |> map char /// Generates a Unicode character, including invalid standalone surrogates: /// '\000'..'\65535' @@ -370,8 +377,7 @@ module Gen = /// Generates a random string using 'Range' to determine the length and the /// specified character generator. let string (range : Range) (g : Gen) : Gen = - sized <| fun _size -> - g |> array range + sized (fun _size -> array range g) |> map String // @@ -416,19 +422,20 @@ module Gen = /// Generates a random 64-bit floating point number. let double (range : Range) : Gen = - create (Shrink.towardsDouble <| Range.origin range) (Random.double range) + Random.double range + |> create (Shrink.towardsDouble (Range.origin range)) /// Generates a random 64-bit floating point number. let float (range : Range) : Gen = - (double range) |> map float + double range |> map float /// Generates a random 32-bit floating point number. let single (range : Range) : Gen = - double (Range.map ExtraTopLevelOperators.double range) |> map single + double (Range.map ExtraTopLevelOperators.double range) |> map single /// Generates a random decimal floating-point number. let decimal (range : Range) : Gen = - double (Range.map ExtraTopLevelOperators.double range) |> map decimal + double (Range.map ExtraTopLevelOperators.double range) |> map decimal // // Combinators - Constructed @@ -436,7 +443,7 @@ module Gen = /// Generates a random globally unique identifier. let guid : Gen = gen { - let! bs = array (Range.constant 16 16) (byte <| Range.constantBounded ()) + let! bs = array (Range.singleton 16) (byte (Range.constantBounded ())) return Guid bs } @@ -494,10 +501,10 @@ module Gen = let forest = sampleTree 10 5 g for tree in forest do printfn "=== Outcome ===" - printfn "%A" <| Tree.outcome tree + printfn "%A" (Tree.outcome tree) printfn "=== Shrinks ===" for shrink in Tree.shrinks tree do - printfn "%A" <| Tree.outcome shrink + printfn "%A" (Tree.outcome shrink) printfn "." [] diff --git a/src/Hedgehog/Property.fs b/src/Hedgehog/Property.fs index b09db026..6d208e17 100644 --- a/src/Hedgehog/Property.fs +++ b/src/Hedgehog/Property.fs @@ -52,7 +52,9 @@ module Journal = Journal xs let toList (Journal xs : Journal) : List = - Seq.toList <| Seq.map (fun f -> f ()) xs + xs + |> Seq.map (fun f -> f ()) + |> Seq.toList let empty : Journal = Seq.empty |> ofList @@ -208,9 +210,9 @@ module Report = | OK -> () | GaveUp -> - raise <| GaveUpException (report) + raise (GaveUpException (report)) | Failed failure -> - raise <| FailedException (failure, report) + raise (FailedException (failure, report)) module Property = @@ -232,16 +234,18 @@ module Property = let using (x : 'a) (k : 'a -> Property<'b>) : Property<'b> when 'a :> IDisposable and 'a : null = - let k' = delay <| fun () -> k x - tryFinally k' <| fun () -> + let k' = delay (fun () -> k x) + tryFinally k' (fun () -> match x with | null -> () | _ -> - x.Dispose () + x.Dispose ()) let filter (p : 'a -> bool) (m : Property<'a>) : Property<'a> = - Gen.map (second <| Result.filter p) (toGen m) |> ofGen + toGen m + |> Gen.map (second (Result.filter p)) + |> ofGen let ofResult (x : Result<'a>) : Property<'a> = (Journal.empty, x) |> Gen.constant |> ofGen @@ -275,14 +279,14 @@ module Property = let private bindGen (m : Gen>) (k : 'a -> Gen>) : Gen> = - Gen.bind m <| fun (journal, result) -> + Gen.bind m (fun (journal, result) -> match result with | Failure -> Gen.constant (journal, Failure) | Discard -> Gen.constant (journal, Discard) | Success x -> - Gen.map (first (Journal.append journal)) (k x) + Gen.map (first (Journal.append journal)) (k x)) let bind (m : Property<'a>) (k : 'a -> Property<'b>) : Property<'b> = bindGen (toGen m) (toGen << k) |> ofGen @@ -442,10 +446,10 @@ module PropertyBuilder = member __.For(xs : seq<'a>, k : 'a -> Property) : Property = let xse = xs.GetEnumerator () - Property.using xse <| fun xse -> + Property.using xse (fun xse -> let mv = xse.MoveNext let kc = Property.delay (fun () -> k xse.Current) - loop mv kc + loop mv kc) member __.While(p : unit -> bool, m : Property) : Property = loop p m @@ -484,9 +488,9 @@ module PropertyBuilder = [] member __.Counterexample(m : Property<'a>, [] f : 'a -> string) : Property<'a> = - Property.bind m <| fun x -> - Property.bind (Property.counterexample (fun () -> f x)) <| fun _ -> - Property.success x + Property.bind m (fun x -> + Property.bind (Property.counterexample (fun () -> f x)) (fun _ -> + Property.success x)) [] member __.Where(m : Property<'a>, [] p : 'a -> bool) : Property<'a> = diff --git a/src/Hedgehog/Random.fs b/src/Hedgehog/Random.fs index 2c83a738..580ea745 100644 --- a/src/Hedgehog/Random.fs +++ b/src/Hedgehog/Random.fs @@ -15,43 +15,42 @@ module Random = unsafeRun seed (max 1 size) r let delay (f : unit -> Random<'a>) : Random<'a> = - Random <| fun seed size -> - f () |> unsafeRun seed size + Random (fun seed size -> + f () |> unsafeRun seed size) let tryFinally (r : Random<'a>) (after : unit -> unit) : Random<'a> = - Random <| fun seed size -> + Random (fun seed size -> try unsafeRun seed size r finally - after () + after ()) let tryWith (r : Random<'a>) (k : exn -> Random<'a>) : Random<'a> = - Random <| fun seed size -> + Random (fun seed size -> try unsafeRun seed size r with - x -> unsafeRun seed size (k x) + x -> unsafeRun seed size (k x)) let constant (x : 'a) : Random<'a> = - Random <| fun _ _ -> - x + Random (fun _ _ -> x) let map (f : 'a -> 'b) (r : Random<'a>) : Random<'b> = - Random <| fun seed size -> + Random (fun seed size -> r |> unsafeRun seed size - |> f + |> f) let bind (r : Random<'a>) (k : 'a -> Random<'b>) : Random<'b> = - Random <| fun seed size -> + Random (fun seed size -> let seed1, seed2 = Seed.split seed r |> unsafeRun seed1 size |> k - |> unsafeRun seed2 size + |> unsafeRun seed2 size) let replicate (times : int) (r : Random<'a>) : Random> = - Random <| fun seed0 size -> + Random (fun seed0 size -> let rec loop seed k acc = if k <= 0 then acc @@ -59,7 +58,7 @@ module Random = let seed1, seed2 = Seed.split seed let x = unsafeRun seed1 size r loop seed2 (k - 1) (x :: acc) - loop seed0 times [] + loop seed0 times []) type Builder internal () = member __.Return(x : 'a) : Random<'a> = @@ -71,28 +70,28 @@ module Random = /// Used to construct generators that depend on the size parameter. let sized (f : Size -> Random<'a>) : Random<'a> = - Random <| fun seed size -> - unsafeRun seed size (f size) + Random (fun seed size -> + unsafeRun seed size (f size)) /// Overrides the size parameter. Returns a generator which uses the /// given size instead of the runtime-size parameter. let resize (newSize : Size) (r : Random<'a>) : Random<'a> = - Random <| fun seed _ -> - run seed newSize r + Random (fun seed _ -> + run seed newSize r) /// Generates a random integral number in the given inclusive range. let inline integral (range : Range<'a>) : Random<'a> = - Random <| fun seed size -> + Random (fun seed size -> let (lo, hi) = Range.bounds size range let x, _ = Seed.nextBigInt (toBigInt lo) (toBigInt hi) seed - fromBigInt x + fromBigInt x) /// Generates a random floating point number in the given inclusive range. let inline double (range : Range) : Random = - Random <| fun seed size -> + Random (fun seed size -> let (lo, hi) = Range.bounds size range let x, _ = Seed.nextDouble lo hi seed - x + x) [] module RandomBuilder = diff --git a/src/Hedgehog/Script.fsx b/src/Hedgehog/Script.fsx index 67aafcdf..4cec1b82 100644 --- a/src/Hedgehog/Script.fsx +++ b/src/Hedgehog/Script.fsx @@ -16,36 +16,35 @@ open System // Combinators // -Property.print <| property { - let! x = Gen.int <| Range.constant 1 100 +Property.print (property { + let! x = Gen.int (Range.constant 1 100) let! ys = Gen.item ["a"; "b"; "c"; "d"] |> Gen.seq (Range.linear 0 100) - counterexample (sprintf "tryHead ys = %A" <| Seq.tryHead ys) + counterexample (sprintf "tryHead ys = %A" (Seq.tryHead ys)) return x < 25 || Seq.length ys <= 3 || Seq.contains "a" ys -} +}) -Property.print <| property { +Property.print (property { let! xs = Gen.string (Range.constant 0 100) Gen.unicode return String.length xs <= 5 -} +}) // // reverse (reverse xs) = xs, ∀xs :: [α] ― The standard "hello-world" property. // -Property.print <| property { +Property.print (property { let! xs = Gen.list (Range.linear 0 100) Gen.alpha - return xs - |> List.rev - |> List.rev - = xs -} + return xs = List.rev (List.rev xs) +}) // // Conditional Generators // let genLeapYear = - Gen.int <| Range.constant 2000 3000 |> Gen.filter DateTime.IsLeapYear + Range.constant 2000 3000 + |> Gen.int + |> Gen.filter DateTime.IsLeapYear Gen.printSample genLeapYear @@ -54,47 +53,47 @@ Gen.printSample genLeapYear // // Fails due to integer overflow -Property.print <| property { - let! x = Gen.int <| Range.constantBounded () - let! y = Gen.int <| Range.constantBounded () +Property.print (property { + let! x = Gen.int (Range.constantBounded ()) + let! y = Gen.int (Range.constantBounded ()) where (x > 0 && y > 0) - counterexample (sprintf "x * y = %d" <| x * y) + counterexample (sprintf "x * y = %d" (x * y)) return x * y > 0 -} +}) // https://github.com/hedgehogqa/fsharp-hedgehog/issues/124#issuecomment-335402728 -Property.check <| property { +Property.check (property { let! x = Range.exponentialBounded () |> Gen.int where (x <> 0) return true -} +}) // // Lazy Properties // -Property.print <| property { - let! n = Gen.int <| Range.constantBounded () +Property.print (property { + let! n = Gen.int (Range.constantBounded ()) where (n <> 0) return 1 / n = 1 / n -} +}) // // Properties that can throw an exception // -Property.print <| property { +Property.print (property { let! (x, y) = Range.constant 0 9 |> Gen.int |> Gen.tuple // The exception gets rendered and added to the journal. failwith "Uh oh" return x + y = x + y -} +}) // // Loops // -Property.print <| property { +Property.print (property { for x in "abcd" do // Custom operations (i.e. counterexample) can't be used in computation // expressions which have control flow :( we can fake it using return! @@ -108,11 +107,11 @@ Property.print <| property { let mutable n = 0 while n < 10 do n <- n + 1 - let! k = Gen.int <| Range.constant 0 n + let! k = Gen.int (Range.constant 0 n) return! Property.counterexample (fun () -> sprintf "n = %d" n) return! Property.counterexample (fun () -> sprintf "k = %d" k) return k <> 5 -} +}) let gs = [ (fun x -> x + 1) @@ -120,25 +119,25 @@ let gs = (fun x -> x / 3) ] |> List.map Gen.constant -Gen.printSample <| gen { +Gen.printSample (gen { let mutable x = 10 for g in gs do let! f = g x <- f x return x -} +}) // // Printing Samples // -Gen.printSample <| gen { - let! x = Gen.int <| Range.constant 0 10 +Gen.printSample (gen { + let! x = Gen.int (Range.constant 0 10) let! y = Gen.item [ "x"; "y"; "z" ] - let! z = Gen.double <| Range.constant 0.1 9.99 + let! z = Gen.double (Range.constant 0.1 9.99) let! w = Gen.string (Range.constant 0 100) Gen.alphaNum return sprintf "%A + %s + %f + %s" x y z w -} +}) // // Printing Samples ― Complex Types @@ -183,17 +182,17 @@ Range.exponentialBounded () // Printing Samples ― System.Net.IPAddress // -Gen.printSample <| gen { +Gen.printSample (gen { let! addr = - Gen.array (Range.constant 4 4) (Gen.byte <| Range.constantBounded ()) - return System.Net.IPAddress addr -} + Gen.array (Range.singleton 4) (Gen.byte (Range.constantBounded ())) + return Net.IPAddress addr +}) // // Printing Samples ― System.Guid // -Gen.printSample <| Gen.guid +Gen.printSample Gen.guid // // Hutton's Razor @@ -217,19 +216,18 @@ let shrinkExp = function #nowarn "40" let rec genExp = - Gen.delay <| fun _ -> - Gen.shrink shrinkExp <| - Gen.choiceRec [ - Lit Gen.int (Range.constantBounded ()) - ] [ - Add Gen.zip genExp genExp - ] - -Property.print <| property { + Gen.delay (fun _ -> + let choiceRec = + Gen.choiceRec + [ Lit Gen.int (Range.constantBounded ()) ] + [ Add Gen.zip genExp genExp ] + Gen.shrink shrinkExp choiceRec) + +Property.print (property { let! x = genExp match x with | Add (Add _, Add _) when evalExp x > 100 -> return false | _ -> return true -} +}) diff --git a/src/Hedgehog/Shrink.fs b/src/Hedgehog/Shrink.fs index b4018c31..398c48b7 100644 --- a/src/Hedgehog/Shrink.fs +++ b/src/Hedgehog/Shrink.fs @@ -50,7 +50,8 @@ module Shrink = /// Shrink a list by edging towards the empty list. /// Note we always try the empty list first, as that is the optimal shrink. let list (xs : List<'a>) : seq> = - Seq.concat <| Seq.map (fun k -> removes k xs) (halves <| List.length xs) + halves (List.length xs) + |> Seq.collect (fun k -> removes k xs) /// Shrink each of the elements in input list using the supplied shrinking /// function. @@ -94,7 +95,9 @@ module Shrink = /// the full range of the type (i.e. 'MinValue' and 'MaxValue' for 'Int32') let diff : ^a = (x / two) - (destination / two) - Seq.consNub destination <| Seq.map (fun y -> x - y) (halves diff) + halves diff + |> Seq.map (fun y -> x - y) + |> Seq.consNub destination /// Shrink a floating-point number by edging towards a destination. /// Note we always try the destination first, as that is the optimal shrink. @@ -113,4 +116,3 @@ module Shrink = None Seq.unfold go diff - diff --git a/tests/Hedgehog.Benchmarks/Program.fs b/tests/Hedgehog.Benchmarks/Program.fs index 2e798c12..2d85007f 100644 --- a/tests/Hedgehog.Benchmarks/Program.fs +++ b/tests/Hedgehog.Benchmarks/Program.fs @@ -9,22 +9,22 @@ open Hedgehog type Benchmarks () = [] - member this.GenInts () = - Property.check <| property { + member _.GenInts () = + Property.check (property { let! i = Gen.int (Range.constant 0 10000) return i >= 0 - } + }) [] - member this.GenAsciiStrings () = - Property.check <| property { + member _.GenAsciiStrings () = + Property.check (property { let! i = Gen.string (Range.constant 0 100) Gen.ascii return i.Length >= 0 - } + }) [] - member this.BigExampleFromTests () = - Hedgehog.Tests.MinimalTests.``greedy traversal with a predicate yields the perfect minimal shrink`` () + member _.BigExampleFromTests () = + Tests.MinimalTests.``greedy traversal with a predicate yields the perfect minimal shrink`` () [] type ScaledBenchmarks () = @@ -35,12 +35,12 @@ type ScaledBenchmarks () = [] member this.ForLoopTest () = - Property.check <| property { - for a = 0 to this.N do - () + Property.check (property { + for _ = 0 to this.N do + () - return true - } + return true + }) [] let main argv = diff --git a/tests/Hedgehog.Tests/GenTests.fs b/tests/Hedgehog.Tests/GenTests.fs index 88d7aefc..75aadb39 100644 --- a/tests/Hedgehog.Tests/GenTests.fs +++ b/tests/Hedgehog.Tests/GenTests.fs @@ -21,14 +21,14 @@ let ``dateTime creates System.DateTime instances`` count = [] let ``unicode doesn't return any surrogate`` () = - let actual = Gen.sample 100 100000 Gen.unicode + let actual = Gen.sample 100 100000 Gen.unicode [] =! List.filter System.Char.IsSurrogate actual [] [] [] let ``unicode doesn't return any noncharacter`` nonchar = - let isNoncharacter = (=) <| Operators.char nonchar + let isNoncharacter = (=) (char nonchar) let actual = Gen.sample 100 100000 Gen.unicode [] =! List.filter isNoncharacter actual @@ -54,7 +54,7 @@ let ``dateTime randomly generates value between max and min ticks`` () = let ``dateTime shrinks to correct mid-value`` () = let result = property { - let! actual = + let! actual = Range.constantFrom (System.DateTime (2000, 1, 1)) System.DateTime.MinValue System.DateTime.MaxValue |> Gen.dateTime System.DateTime.Now =! actual @@ -68,14 +68,14 @@ let ``dateTime shrinks to correct mid-value`` () = [] let ``int64 can create exponentially bounded integer`` () = - Property.check <| property { + Property.check (property { let! _ = Gen.int64 (Range.exponentialBounded ()) return true - } + }) [] let ``uint64 can create exponentially bounded integer`` () = - Property.check <| property { + Property.check (property { let! _ = Gen.uint64 (Range.exponentialBounded ()) return true - } \ No newline at end of file + }) diff --git a/tests/Hedgehog.Tests/MinimalTests.fs b/tests/Hedgehog.Tests/MinimalTests.fs index b5c7d20b..760c6399 100644 --- a/tests/Hedgehog.Tests/MinimalTests.fs +++ b/tests/Hedgehog.Tests/MinimalTests.fs @@ -53,19 +53,20 @@ let rec tryFindSmallest (p : 'a -> bool) (Node (x, xs) : Tree<'a>) : 'a option = #nowarn "40" // This will not be initialized if using version <= 15.7.0 of Microsoft.NET.Test.SDK let rec genExp : Gen = - Gen.delay <| fun _ -> - Gen.shrink shrinkExp <| // comment this out to see the property fail - Gen.choiceRec [ - Lit Gen.int (Range.constant 0 10) - Var genName - ] [ - Lam Gen.zip genName genExp - App Gen.zip genExp genExp - ] + Gen.delay (fun _ -> + let choiceRec = + Gen.choiceRec [ + Lit Gen.int (Range.constant 0 10) + Var genName + ] [ + Lam Gen.zip genName genExp + App Gen.zip genExp genExp + ] + Gen.shrink shrinkExp choiceRec) // comment this out to see the property fail [] let ``greedy traversal with a predicate yields the perfect minimal shrink``() = - Property.check <| property { + Property.check (property { let! xs = Gen.mapTree Tree.duplicate genExp |> Gen.resize 20 match tryFindSmallest noAppLit10 xs with | None -> @@ -83,4 +84,4 @@ let ``greedy traversal with a predicate yields the perfect minimal shrink``() = counterexample (sprintf "%A" x) return false } - } + }) diff --git a/tests/Hedgehog.Tests/RangeTests.fs b/tests/Hedgehog.Tests/RangeTests.fs index 92247de8..41e25b98 100644 --- a/tests/Hedgehog.Tests/RangeTests.fs +++ b/tests/Hedgehog.Tests/RangeTests.fs @@ -15,7 +15,7 @@ open Xunit [] let ``singleton bounds returns correct result`` sz x = let actual = - Range.bounds sz <| Range.singleton x + Range.bounds sz (Range.singleton x) (x, x) =! actual @@ -30,7 +30,7 @@ let ``singleton bounds returns correct result`` sz x = [] let ``singleton origin returns correct result`` x = let actual = - Range.origin <| Range.singleton x + Range.origin (Range.singleton x) x =! actual @@ -44,7 +44,7 @@ let ``singleton origin returns correct result`` x = [] let ``constant bounds returns correct result`` sz x y = let actual = - Range.bounds sz <| Range.constant x y + Range.bounds sz (Range.constant x y) (x, y) =! actual @@ -58,7 +58,7 @@ let ``constant bounds returns correct result`` sz x y = [] let ``constant origin returns correct result`` x y = let actual = - Range.origin <| Range.constant x y + Range.origin (Range.constant x y) x =! actual @@ -73,7 +73,7 @@ let ``constant origin returns correct result`` x y = [] let ``range from -x to x, with the origin at`` x = let actual = - Range.origin <| Range.constantFrom x -10 10 + Range.origin (Range.constantFrom x -10 10) x =! actual @@ -87,7 +87,7 @@ let ``range from -x to x, with the origin at`` x = [] let ``range from -x to x, with the bounds at`` sz x = let actual = - Range.bounds sz <| Range.constantFrom 0 -x x + Range.bounds sz (Range.constantFrom 0 -x x) (-x, x) =! actual @@ -102,7 +102,7 @@ let ``range from -x to x, with the bounds at`` sz x = [] let ``constantBounded bounds returns correct result - Byte range`` sz = let x = - Range.bounds sz <| (Range.constantBounded () : Range) + Range.bounds sz (Range.constantBounded () : Range) (Byte.MinValue, Byte.MaxValue) =! x @@ -117,7 +117,7 @@ let ``constantBounded bounds returns correct result - Byte range`` sz = [] let ``constantBounded bounds returns correct result - Int32 range`` sz = let x = - Range.bounds sz <| (Range.constantBounded () : Range) + Range.bounds sz (Range.constantBounded () : Range) (Int32.MinValue, Int32.MaxValue) =! x @@ -132,7 +132,7 @@ let ``constantBounded bounds returns correct result - Int32 range`` sz = [] let ``constantBounded bounds returns correct result - Int64 range`` sz = let x = - Range.bounds sz <| (Range.constantBounded () : Range) + Range.bounds sz (Range.constantBounded () : Range) (Int64.MinValue, Int64.MaxValue) =! x @@ -148,125 +148,125 @@ let ``clamp truncates a value so it stays within some range `` x y n expected = [] let ``linear scales the second bound relative to the size - example 1`` () = let actual = - Range.bounds 0 <| Range.linear 0 10 + Range.bounds 0 (Range.linear 0 10) (0, 0) =! actual [] let ``linear scales the second bound relative to the size - example 2`` () = let actual = - Range.bounds 50 <| Range.linear 0 10 + Range.bounds 50 (Range.linear 0 10) (0, 5) =! actual [] let ``linear scales the second bound relative to the size - example 3`` () = let actual = - Range.bounds 99 <| Range.linear 0 10 + Range.bounds 99 (Range.linear 0 10) (0, 10) =! actual [] let ``linearFrom scales the bounds relative to the size - example 1`` () = let actual = - Range.bounds 0 <| Range.linearFrom 0 -10 10 + Range.bounds 0 (Range.linearFrom 0 -10 10) (0, 0) =! actual [] let ``linearFrom scales the bounds relative to the size - example 2`` () = let actual = - Range.bounds 50 <| Range.linearFrom 0 -10 20 + Range.bounds 50 (Range.linearFrom 0 -10 20) (-5, 10) =! actual [] let ``linearFrom scales the bounds relative to the size - example 3`` () = let actual = - Range.bounds 99 <| Range.linearFrom 0 -10 20 + Range.bounds 99 (Range.linearFrom 0 -10 20) (-10, 20) =! actual [] let ``linearBounded uses the full range of a data type - example 1`` () = let actual = - Range.bounds 0 <| (Range.linearBounded () : Range) + Range.bounds 0 (Range.linearBounded () : Range) (-0y, 0y) =! actual [] let ``linearBounded uses the full range of a data type - example 2`` () = let actual = - Range.bounds 50 <| (Range.linearBounded () : Range) + Range.bounds 50 (Range.linearBounded () : Range) (-64y, 64y) =! actual [] let ``linearBounded uses the full range of a data type - example 3`` () = let actual = - Range.bounds 99 <| (Range.linearBounded () : Range) + Range.bounds 99 (Range.linearBounded () : Range) (-128y, 127y) =! actual [] let ``exponential scales the second bound exponentially relative to the size - example 1`` () = let actual = - Range.bounds 0 <| Range.exponential 1 512 + Range.bounds 0 (Range.exponential 1 512) (1, 1) =! actual [] let ``exponential scales the second bound exponentially relative to the size - example 2`` () = let actual = - Range.bounds 77 <| Range.exponential 1 512 + Range.bounds 77 (Range.exponential 1 512) (1, 128) =! actual [] let ``exponential scales the second bound exponentially relative to the size - example 3`` () = let actual = - Range.bounds 99 <| Range.exponential 1 512 + Range.bounds 99 (Range.exponential 1 512) (1, 512) =! actual [] let ``exponentialFrom scales the bounds exponentially relative to the size - example 1`` () = let actual = - Range.bounds 0 <| Range.exponentialFrom 0 -128 512 + Range.bounds 0 (Range.exponentialFrom 0 -128 512) (0, 0) =! actual [] let ``exponentialFrom scales the bounds exponentially relative to the size - example 2`` () = let actual = - Range.bounds 50 <| Range.exponentialFrom 0 -128 512 + Range.bounds 50 (Range.exponentialFrom 0 -128 512) (-11, 22) =! actual [] let ``exponentialFrom scales the bounds exponentially relative to the size - example 3`` () = let actual = - Range.bounds 99 <| Range.exponentialFrom 3 -128 512 + Range.bounds 99 (Range.exponentialFrom 3 -128 512) (-128, 512) =! actual [] let ``exponentialBounded uses the full range of a data type - example 1`` () = let actual = - Range.bounds 0 <| (Range.exponentialBounded () : Range) + Range.bounds 0 (Range.exponentialBounded () : Range) (-0y, 0y) =! actual [] let ``exponentialBounded uses the full range of a data type - example 2`` () = let actual = - Range.bounds 50 <| (Range.exponentialBounded () : Range) + Range.bounds 50 (Range.exponentialBounded () : Range) (-11y, 11y) =! actual [] let ``exponentialBounded uses the full range of a data type - example 3`` () = let actual = - Range.bounds 99 <| (Range.exponentialBounded () : Range) + Range.bounds 99 (Range.exponentialBounded () : Range) (-128y, 127y) =! actual diff --git a/tests/Hedgehog.Tests/ShrinkTests.fs b/tests/Hedgehog.Tests/ShrinkTests.fs index c989edab..8b36cffd 100644 --- a/tests/Hedgehog.Tests/ShrinkTests.fs +++ b/tests/Hedgehog.Tests/ShrinkTests.fs @@ -18,49 +18,49 @@ let ``removes permutes a list by removing 'k' consecutive elements from it``() = [] let ``removes produces all permutations of removing 'k' elements from a list - example 1`` () = let actual = - Seq.toList <| Shrink.removes 2 [1; 2; 3; 4; 5; 6] + Seq.toList (Shrink.removes 2 [1; 2; 3; 4; 5; 6]) [[3; 4; 5; 6]; [1; 2; 5; 6]; [1; 2; 3; 4]] =! actual [] let ``removes produces all permutations of removing 'k' elements from a list - example 2`` () = let actual = - Seq.toList <| Shrink.removes 3 [1; 2; 3; 4; 5; 6] + Seq.toList (Shrink.removes 3 [1; 2; 3; 4; 5; 6]) [[4; 5; 6]; [1; 2; 3]] =! actual [] let ``removes produces all permutations of removing 'k' elements from a list - example 3`` () = let actual = - Seq.toList <| Shrink.removes 2 ["a"; "b"; "c"; "d"; "e"; "f"] + Seq.toList (Shrink.removes 2 ["a"; "b"; "c"; "d"; "e"; "f"]) [["c"; "d"; "e"; "f"]; ["a"; "b"; "e"; "f"]; ["a"; "b"; "c"; "d"]] =! actual [] let ``halves produces a list containing the progressive halving of an integral - example 1`` () = let actual = - Seq.toList <| Shrink.halves 15 + Seq.toList (Shrink.halves 15) [15; 7; 3; 1] =! actual [] let ``halves produces a list containing the progressive halving of an integral - example 2`` () = let actual = - Seq.toList <| Shrink.halves 100 + Seq.toList (Shrink.halves 100) [100; 50; 25; 12; 6; 3; 1] =! actual [] let ``halves produces a list containing the progressive halving of an integral - example 3`` () = let actual = - Seq.toList <| Shrink.halves -26 + Seq.toList (Shrink.halves -26) [-26; -13; -6; -3; -1] =! actual [] let ``list shrinks a list by edging towards the empty list - example 1`` () = let actual = - Seq.toList <| Shrink.list [1; 2; 3] + Seq.toList (Shrink.list [1; 2; 3]) [[]; [2; 3]; [1; 3]; [1; 2]] =! actual [] let ``list shrinks a list by edging towards the empty list - example 2`` () = let actual = - Seq.toList <| Shrink.list ["a"; "b"; "c"; "d"] + Seq.toList (Shrink.list ["a"; "b"; "c"; "d"]) [ [] [ "c"; "d" ] [ "a"; "b" ] @@ -73,31 +73,31 @@ let ``list shrinks a list by edging towards the empty list - example 2`` () = [] let ``towards shrinks an integral number by edging towards a destination - exmaple 1`` () = let actual = - Seq.toList <| Shrink.towards 0 100 + Seq.toList (Shrink.towards 0 100) [0; 50; 75; 88; 94; 97; 99] =! actual [] let ``towards shrinks an integral number by edging towards a destination - exmaple 2`` () = let actual = - Seq.toList <| Shrink.towards 500 1000 + Seq.toList (Shrink.towards 500 1000) [500; 750; 875; 938; 969; 985; 993; 997; 999] =! actual [] let ``towards shrinks an integral number by edging towards a destination - exmaple 3`` () = let actual = - Seq.toList <| Shrink.towards -50 -26 + Seq.toList (Shrink.towards -50 -26) [-50; -38; -32; -29; -27] =! actual [] let ``towardsDouble shrinks a floating-point number by edging towards a destination - example 1`` () = let actual = - Seq.toList << Seq.take 7 <| Shrink.towardsDouble 0.0 100.0 + (Seq.toList << Seq.take 7) (Shrink.towardsDouble 0.0 100.0) [0.0; 50.0; 75.0; 87.5; 93.75; 96.875; 98.4375] =! actual [] let ``towardsDouble shrinks a floating-point number by edging towards a destination - example 2`` () = let actual = - Seq.toList << Seq.take 7 <| Shrink.towardsDouble 1.0 0.5 + (Seq.toList << Seq.take 7) (Shrink.towardsDouble 1.0 0.5) [1.0; 0.75; 0.625; 0.5625; 0.53125; 0.515625; 0.5078125] =! actual [] diff --git a/tests/Hedgehog.Tests/TreeTests.fs b/tests/Hedgehog.Tests/TreeTests.fs index 60621087..ad393a61 100644 --- a/tests/Hedgehog.Tests/TreeTests.fs +++ b/tests/Hedgehog.Tests/TreeTests.fs @@ -6,7 +6,7 @@ open Xunit [] let ``render tree with depth 0`` () = - Property.check <| property { + Property.check (property { let! x0 = Gen.constant "0" let tree = @@ -18,11 +18,11 @@ let ``render tree with depth 0`` () = sprintf "%A" x0 ] test <@ expected = Tree.renderList tree @> - } + }) [] let ``render tree with depth 1`` () = - Property.check <| property { + Property.check (property { let! x0 = Gen.constant "0" let! x1 = Gen.constant "1" let! x2 = Gen.constant "2" @@ -43,11 +43,11 @@ let ``render tree with depth 1`` () = sprintf "└-%A" x3 ] test <@ expected = Tree.renderList tree @> - } + }) [] let ``render tree with depth 2`` () = - Property.check <| property { + Property.check (property { let! x0 = Gen.constant "0" let! x1 = Gen.constant "1" let! x2 = Gen.constant "2" @@ -98,4 +98,4 @@ let ``render tree with depth 2`` () = sprintf " └-%A" x12 ] test <@ expected = Tree.renderList tree @> - } + }) From c31ca083d6c137253220cb49c2529a704a76544a Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Mon, 18 Jan 2021 17:44:12 +0000 Subject: [PATCH 2/5] Better usage of forward pipe --- doc/tutorial.md | 15 +++--- src/Hedgehog/Gen.fs | 23 +++++--- src/Hedgehog/Script.fsx | 10 ++-- tests/Hedgehog.Tests/GenTests.fs | 3 +- tests/Hedgehog.Tests/MinimalTests.fs | 19 ++++--- tests/Hedgehog.Tests/RangeTests.fs | 81 ++++++++++++++++++---------- tests/Hedgehog.Tests/ShrinkTests.fs | 41 +++++++++----- 7 files changed, 121 insertions(+), 71 deletions(-) diff --git a/doc/tutorial.md b/doc/tutorial.md index bddc7129..529f4581 100644 --- a/doc/tutorial.md +++ b/doc/tutorial.md @@ -27,7 +27,7 @@ One way to use Hedgehog to check the above property is to use the `property` com ```fs property { - let! xs = Gen.list (Range.linear 0 100) (Gen.int (Range.constant 0 1000)) + let! xs = Range.constant 0 1000 |> Gen.int |> Gen.list (Range.linear 0 100) return List.rev (List.rev xs) = xs } ``` @@ -36,7 +36,7 @@ and to test the above property on 100 random lists of integers, pipe it into `Pr ```fs property { - let! xs = Gen.list (Range.linear 0 100) (Gen.int (Range.constant 0 1000)) + let! xs = Range.constant 0 1000 |> Gen.int |> Gen.list (Range.linear 0 100) return List.rev (List.rev xs) = xs } |> Property.print @@ -351,11 +351,10 @@ Hedgehog supports a convenient syntax for working with generators through the `g ```fs open System.Net -let ipAddressGen : Gen = - gen { - let! addr = Gen.array (Range.singleton 4) (Gen.byte (Range.constantBounded ())) - return System.Net.IPAddress addr - } +let ipAddressGen : Gen = gen { + let! addr = Range.constantBounded () |> Gen.byte |> Gen.array (Range.singleton 4) + return System.Net.IPAddress addr +} ipAddressGen |> Gen.printSample;; @@ -559,7 +558,7 @@ Hedgehog will then attempt to generate a test case that *falsifies* the assertio Values for `xs` need to be generated by a generator, as shown in the *Generators* sections. The following one is for lists of type integer: ```fs -let g = Gen.list (Range.linear 0 20) (Gen.int (Range.constant 0 100));; +let g = Range.constant 0 100 |> Gen.int |> Gen.list (Range.linear 0 20);; val g : Gen ``` diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index 2ef41b77..db74def7 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -163,7 +163,11 @@ module Gen = /// Generates a random number in the given inclusive range. let inline integral (range : Range<'a>) : Gen<'a> = - create (Shrink.towards (Range.origin range)) (Random.integral range) + let shrink = + Shrink.towards (Range.origin range) + + Random.integral range + |> create shrink // // Combinators - Choice @@ -224,13 +228,16 @@ module Gen = /// The first argument (i.e. the non-recursive input list) must be non-empty. let choiceRec (nonrecs : seq>) (recs : seq>) : Gen<'a> = sized (fun n -> - if n <= 1 then - choice nonrecs - else - recs - |> Seq.map (scale (fun x -> x / 2)) - |> Seq.append nonrecs - |> choice + let scaledRecs = + if n <= 1 then + Seq.empty + else + recs + |> Seq.map (scale (fun x -> x / 2)) + + scaledRecs + |> Seq.append nonrecs + |> choice ) // diff --git a/src/Hedgehog/Script.fsx b/src/Hedgehog/Script.fsx index 4cec1b82..d7bea053 100644 --- a/src/Hedgehog/Script.fsx +++ b/src/Hedgehog/Script.fsx @@ -54,8 +54,8 @@ Gen.printSample genLeapYear // Fails due to integer overflow Property.print (property { - let! x = Gen.int (Range.constantBounded ()) - let! y = Gen.int (Range.constantBounded ()) + let! x = Range.constantBounded () |> Gen.int + let! y = Range.constantBounded () |> Gen.int where (x > 0 && y > 0) counterexample (sprintf "x * y = %d" (x * y)) return x * y > 0 @@ -73,7 +73,7 @@ Property.check (property { // Property.print (property { - let! n = Gen.int (Range.constantBounded ()) + let! n = Range.constantBounded () |> Gen.int where (n <> 0) return 1 / n = 1 / n }) @@ -107,7 +107,7 @@ Property.print (property { let mutable n = 0 while n < 10 do n <- n + 1 - let! k = Gen.int (Range.constant 0 n) + let! k = Range.constant 0 n |> Gen.int return! Property.counterexample (fun () -> sprintf "n = %d" n) return! Property.counterexample (fun () -> sprintf "k = %d" k) return k <> 5 @@ -184,7 +184,7 @@ Range.exponentialBounded () Gen.printSample (gen { let! addr = - Gen.array (Range.singleton 4) (Gen.byte (Range.constantBounded ())) + Range.constantBounded () |> Gen.byte |> Gen.array (Range.singleton 4) return Net.IPAddress addr }) diff --git a/tests/Hedgehog.Tests/GenTests.fs b/tests/Hedgehog.Tests/GenTests.fs index 75aadb39..17f8346e 100644 --- a/tests/Hedgehog.Tests/GenTests.fs +++ b/tests/Hedgehog.Tests/GenTests.fs @@ -28,9 +28,8 @@ let ``unicode doesn't return any surrogate`` () = [] [] let ``unicode doesn't return any noncharacter`` nonchar = - let isNoncharacter = (=) (char nonchar) let actual = Gen.sample 100 100000 Gen.unicode - [] =! List.filter isNoncharacter actual + [] =! List.filter (fun ch -> ch = char nonchar) actual [] let ``dateTime randomly generates value between max and min ticks`` () = diff --git a/tests/Hedgehog.Tests/MinimalTests.fs b/tests/Hedgehog.Tests/MinimalTests.fs index 760c6399..9e547107 100644 --- a/tests/Hedgehog.Tests/MinimalTests.fs +++ b/tests/Hedgehog.Tests/MinimalTests.fs @@ -54,14 +54,17 @@ let rec tryFindSmallest (p : 'a -> bool) (Node (x, xs) : Tree<'a>) : 'a option = // This will not be initialized if using version <= 15.7.0 of Microsoft.NET.Test.SDK let rec genExp : Gen = Gen.delay (fun _ -> - let choiceRec = - Gen.choiceRec [ - Lit Gen.int (Range.constant 0 10) - Var genName - ] [ - Lam Gen.zip genName genExp - App Gen.zip genExp genExp - ] + let recs = [ + Lit Gen.int (Range.constant 0 10) + Var genName + ] + + let nonrecs = [ + Lam Gen.zip genName genExp + App Gen.zip genExp genExp + ] + + let choiceRec = Gen.choiceRec recs nonrecs Gen.shrink shrinkExp choiceRec) // comment this out to see the property fail [] diff --git a/tests/Hedgehog.Tests/RangeTests.fs b/tests/Hedgehog.Tests/RangeTests.fs index 41e25b98..7b9de5e7 100644 --- a/tests/Hedgehog.Tests/RangeTests.fs +++ b/tests/Hedgehog.Tests/RangeTests.fs @@ -15,7 +15,8 @@ open Xunit [] let ``singleton bounds returns correct result`` sz x = let actual = - Range.bounds sz (Range.singleton x) + Range.singleton x + |> Range.bounds sz (x, x) =! actual @@ -30,7 +31,8 @@ let ``singleton bounds returns correct result`` sz x = [] let ``singleton origin returns correct result`` x = let actual = - Range.origin (Range.singleton x) + Range.singleton x + |> Range.origin x =! actual @@ -44,7 +46,8 @@ let ``singleton origin returns correct result`` x = [] let ``constant bounds returns correct result`` sz x y = let actual = - Range.bounds sz (Range.constant x y) + Range.constant x y + |> Range.bounds sz (x, y) =! actual @@ -58,7 +61,8 @@ let ``constant bounds returns correct result`` sz x y = [] let ``constant origin returns correct result`` x y = let actual = - Range.origin (Range.constant x y) + Range.constant x y + |> Range.origin x =! actual @@ -73,7 +77,8 @@ let ``constant origin returns correct result`` x y = [] let ``range from -x to x, with the origin at`` x = let actual = - Range.origin (Range.constantFrom x -10 10) + Range.constantFrom x -10 10 + |> Range.origin x =! actual @@ -87,7 +92,8 @@ let ``range from -x to x, with the origin at`` x = [] let ``range from -x to x, with the bounds at`` sz x = let actual = - Range.bounds sz (Range.constantFrom 0 -x x) + Range.constantFrom 0 -x x + |> Range.bounds sz (-x, x) =! actual @@ -102,7 +108,8 @@ let ``range from -x to x, with the bounds at`` sz x = [] let ``constantBounded bounds returns correct result - Byte range`` sz = let x = - Range.bounds sz (Range.constantBounded () : Range) + Range.constantBounded () : Range + |> Range.bounds sz (Byte.MinValue, Byte.MaxValue) =! x @@ -117,7 +124,8 @@ let ``constantBounded bounds returns correct result - Byte range`` sz = [] let ``constantBounded bounds returns correct result - Int32 range`` sz = let x = - Range.bounds sz (Range.constantBounded () : Range) + Range.constantBounded () : Range + |> Range.bounds sz (Int32.MinValue, Int32.MaxValue) =! x @@ -132,7 +140,8 @@ let ``constantBounded bounds returns correct result - Int32 range`` sz = [] let ``constantBounded bounds returns correct result - Int64 range`` sz = let x = - Range.bounds sz (Range.constantBounded () : Range) + Range.constantBounded () : Range + |> Range.bounds sz (Int64.MinValue, Int64.MaxValue) =! x @@ -148,125 +157,143 @@ let ``clamp truncates a value so it stays within some range `` x y n expected = [] let ``linear scales the second bound relative to the size - example 1`` () = let actual = - Range.bounds 0 (Range.linear 0 10) + Range.linear 0 10 + |> Range.bounds 0 (0, 0) =! actual [] let ``linear scales the second bound relative to the size - example 2`` () = let actual = - Range.bounds 50 (Range.linear 0 10) + Range.linear 0 10 + |> Range.bounds 50 (0, 5) =! actual [] let ``linear scales the second bound relative to the size - example 3`` () = let actual = - Range.bounds 99 (Range.linear 0 10) + Range.linear 0 10 + |> Range.bounds 99 (0, 10) =! actual [] let ``linearFrom scales the bounds relative to the size - example 1`` () = let actual = - Range.bounds 0 (Range.linearFrom 0 -10 10) + Range.linearFrom 0 -10 10 + |> Range.bounds 0 (0, 0) =! actual [] let ``linearFrom scales the bounds relative to the size - example 2`` () = let actual = - Range.bounds 50 (Range.linearFrom 0 -10 20) + Range.linearFrom 0 -10 20 + |> Range.bounds 50 (-5, 10) =! actual [] let ``linearFrom scales the bounds relative to the size - example 3`` () = let actual = - Range.bounds 99 (Range.linearFrom 0 -10 20) + Range.linearFrom 0 -10 20 + |> Range.bounds 99 (-10, 20) =! actual [] let ``linearBounded uses the full range of a data type - example 1`` () = let actual = - Range.bounds 0 (Range.linearBounded () : Range) + Range.linearBounded () : Range + |> Range.bounds 0 (-0y, 0y) =! actual [] let ``linearBounded uses the full range of a data type - example 2`` () = let actual = - Range.bounds 50 (Range.linearBounded () : Range) + Range.linearBounded () : Range + |> Range.bounds 50 (-64y, 64y) =! actual [] let ``linearBounded uses the full range of a data type - example 3`` () = let actual = - Range.bounds 99 (Range.linearBounded () : Range) + Range.linearBounded () : Range + |> Range.bounds 99 (-128y, 127y) =! actual [] let ``exponential scales the second bound exponentially relative to the size - example 1`` () = let actual = - Range.bounds 0 (Range.exponential 1 512) + Range.exponential 1 512 + |> Range.bounds 0 (1, 1) =! actual [] let ``exponential scales the second bound exponentially relative to the size - example 2`` () = let actual = - Range.bounds 77 (Range.exponential 1 512) + Range.exponential 1 512 + |> Range.bounds 77 (1, 128) =! actual [] let ``exponential scales the second bound exponentially relative to the size - example 3`` () = let actual = - Range.bounds 99 (Range.exponential 1 512) + Range.exponential 1 512 + |> Range.bounds 99 (1, 512) =! actual [] let ``exponentialFrom scales the bounds exponentially relative to the size - example 1`` () = let actual = - Range.bounds 0 (Range.exponentialFrom 0 -128 512) + Range.exponentialFrom 0 -128 512 + |> Range.bounds 0 (0, 0) =! actual [] let ``exponentialFrom scales the bounds exponentially relative to the size - example 2`` () = let actual = - Range.bounds 50 (Range.exponentialFrom 0 -128 512) + Range.exponentialFrom 0 -128 512 + |> Range.bounds 50 (-11, 22) =! actual [] let ``exponentialFrom scales the bounds exponentially relative to the size - example 3`` () = let actual = - Range.bounds 99 (Range.exponentialFrom 3 -128 512) + Range.exponentialFrom 3 -128 512 + |> Range.bounds 99 (-128, 512) =! actual [] let ``exponentialBounded uses the full range of a data type - example 1`` () = let actual = - Range.bounds 0 (Range.exponentialBounded () : Range) + Range.exponentialBounded () : Range + |> Range.bounds 0 (-0y, 0y) =! actual [] let ``exponentialBounded uses the full range of a data type - example 2`` () = let actual = - Range.bounds 50 (Range.exponentialBounded () : Range) + Range.exponentialBounded () : Range + |> Range.bounds 50 (-11y, 11y) =! actual [] let ``exponentialBounded uses the full range of a data type - example 3`` () = let actual = - Range.bounds 99 (Range.exponentialBounded () : Range) + Range.exponentialBounded () : Range + |> Range.bounds 99 (-128y, 127y) =! actual diff --git a/tests/Hedgehog.Tests/ShrinkTests.fs b/tests/Hedgehog.Tests/ShrinkTests.fs index 8b36cffd..f60a2507 100644 --- a/tests/Hedgehog.Tests/ShrinkTests.fs +++ b/tests/Hedgehog.Tests/ShrinkTests.fs @@ -18,49 +18,57 @@ let ``removes permutes a list by removing 'k' consecutive elements from it``() = [] let ``removes produces all permutations of removing 'k' elements from a list - example 1`` () = let actual = - Seq.toList (Shrink.removes 2 [1; 2; 3; 4; 5; 6]) + Shrink.removes 2 [1; 2; 3; 4; 5; 6] + |> Seq.toList [[3; 4; 5; 6]; [1; 2; 5; 6]; [1; 2; 3; 4]] =! actual [] let ``removes produces all permutations of removing 'k' elements from a list - example 2`` () = let actual = - Seq.toList (Shrink.removes 3 [1; 2; 3; 4; 5; 6]) + Shrink.removes 3 [1; 2; 3; 4; 5; 6] + |> Seq.toList [[4; 5; 6]; [1; 2; 3]] =! actual [] let ``removes produces all permutations of removing 'k' elements from a list - example 3`` () = let actual = - Seq.toList (Shrink.removes 2 ["a"; "b"; "c"; "d"; "e"; "f"]) + Shrink.removes 2 ["a"; "b"; "c"; "d"; "e"; "f"] + |> Seq.toList [["c"; "d"; "e"; "f"]; ["a"; "b"; "e"; "f"]; ["a"; "b"; "c"; "d"]] =! actual [] let ``halves produces a list containing the progressive halving of an integral - example 1`` () = let actual = - Seq.toList (Shrink.halves 15) + Shrink.halves 15 + |> Seq.toList [15; 7; 3; 1] =! actual [] let ``halves produces a list containing the progressive halving of an integral - example 2`` () = let actual = - Seq.toList (Shrink.halves 100) + Shrink.halves 100 + |> Seq.toList [100; 50; 25; 12; 6; 3; 1] =! actual [] let ``halves produces a list containing the progressive halving of an integral - example 3`` () = let actual = - Seq.toList (Shrink.halves -26) + Shrink.halves -26 + |> Seq.toList [-26; -13; -6; -3; -1] =! actual [] let ``list shrinks a list by edging towards the empty list - example 1`` () = let actual = - Seq.toList (Shrink.list [1; 2; 3]) + Shrink.list [1; 2; 3] + |> Seq.toList [[]; [2; 3]; [1; 3]; [1; 2]] =! actual [] let ``list shrinks a list by edging towards the empty list - example 2`` () = let actual = - Seq.toList (Shrink.list ["a"; "b"; "c"; "d"]) + Shrink.list ["a"; "b"; "c"; "d"] + |> Seq.toList [ [] [ "c"; "d" ] [ "a"; "b" ] @@ -73,31 +81,38 @@ let ``list shrinks a list by edging towards the empty list - example 2`` () = [] let ``towards shrinks an integral number by edging towards a destination - exmaple 1`` () = let actual = - Seq.toList (Shrink.towards 0 100) + Shrink.towards 0 100 + |> Seq.toList [0; 50; 75; 88; 94; 97; 99] =! actual [] let ``towards shrinks an integral number by edging towards a destination - exmaple 2`` () = let actual = - Seq.toList (Shrink.towards 500 1000) + Shrink.towards 500 1000 + |> Seq.toList [500; 750; 875; 938; 969; 985; 993; 997; 999] =! actual [] let ``towards shrinks an integral number by edging towards a destination - exmaple 3`` () = let actual = - Seq.toList (Shrink.towards -50 -26) + Shrink.towards -50 -26 + |> Seq.toList [-50; -38; -32; -29; -27] =! actual [] let ``towardsDouble shrinks a floating-point number by edging towards a destination - example 1`` () = let actual = - (Seq.toList << Seq.take 7) (Shrink.towardsDouble 0.0 100.0) + Shrink.towardsDouble 0.0 100.0 + |> Seq.take 7 + |> Seq.toList [0.0; 50.0; 75.0; 87.5; 93.75; 96.875; 98.4375] =! actual [] let ``towardsDouble shrinks a floating-point number by edging towards a destination - example 2`` () = let actual = - (Seq.toList << Seq.take 7) (Shrink.towardsDouble 1.0 0.5) + Shrink.towardsDouble 1.0 0.5 + |> Seq.take 7 + |> Seq.toList [1.0; 0.75; 0.625; 0.5625; 0.53125; 0.515625; 0.5078125] =! actual [] From 314ee52fb736711a1fe077cb3e17624e4abe600c Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Mon, 18 Jan 2021 17:50:23 +0000 Subject: [PATCH 3/5] Fix range tests --- tests/Hedgehog.Tests/RangeTests.fs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/Hedgehog.Tests/RangeTests.fs b/tests/Hedgehog.Tests/RangeTests.fs index 7b9de5e7..12a627dd 100644 --- a/tests/Hedgehog.Tests/RangeTests.fs +++ b/tests/Hedgehog.Tests/RangeTests.fs @@ -108,7 +108,7 @@ let ``range from -x to x, with the bounds at`` sz x = [] let ``constantBounded bounds returns correct result - Byte range`` sz = let x = - Range.constantBounded () : Range + (Range.constantBounded () : Range) |> Range.bounds sz (Byte.MinValue, Byte.MaxValue) =! x @@ -124,7 +124,7 @@ let ``constantBounded bounds returns correct result - Byte range`` sz = [] let ``constantBounded bounds returns correct result - Int32 range`` sz = let x = - Range.constantBounded () : Range + (Range.constantBounded () : Range) |> Range.bounds sz (Int32.MinValue, Int32.MaxValue) =! x @@ -140,7 +140,7 @@ let ``constantBounded bounds returns correct result - Int32 range`` sz = [] let ``constantBounded bounds returns correct result - Int64 range`` sz = let x = - Range.constantBounded () : Range + (Range.constantBounded () : Range) |> Range.bounds sz (Int64.MinValue, Int64.MaxValue) =! x @@ -205,7 +205,7 @@ let ``linearFrom scales the bounds relative to the size - example 3`` () = [] let ``linearBounded uses the full range of a data type - example 1`` () = let actual = - Range.linearBounded () : Range + (Range.linearBounded () : Range) |> Range.bounds 0 (-0y, 0y) =! actual @@ -213,7 +213,7 @@ let ``linearBounded uses the full range of a data type - example 1`` () = [] let ``linearBounded uses the full range of a data type - example 2`` () = let actual = - Range.linearBounded () : Range + (Range.linearBounded () : Range) |> Range.bounds 50 (-64y, 64y) =! actual @@ -221,7 +221,7 @@ let ``linearBounded uses the full range of a data type - example 2`` () = [] let ``linearBounded uses the full range of a data type - example 3`` () = let actual = - Range.linearBounded () : Range + (Range.linearBounded () : Range) |> Range.bounds 99 (-128y, 127y) =! actual @@ -277,7 +277,7 @@ let ``exponentialFrom scales the bounds exponentially relative to the size - exa [] let ``exponentialBounded uses the full range of a data type - example 1`` () = let actual = - Range.exponentialBounded () : Range + (Range.exponentialBounded () : Range) |> Range.bounds 0 (-0y, 0y) =! actual @@ -285,7 +285,7 @@ let ``exponentialBounded uses the full range of a data type - example 1`` () = [] let ``exponentialBounded uses the full range of a data type - example 2`` () = let actual = - Range.exponentialBounded () : Range + (Range.exponentialBounded () : Range) |> Range.bounds 50 (-11y, 11y) =! actual @@ -293,7 +293,7 @@ let ``exponentialBounded uses the full range of a data type - example 2`` () = [] let ``exponentialBounded uses the full range of a data type - example 3`` () = let actual = - Range.exponentialBounded () : Range + (Range.exponentialBounded () : Range) |> Range.bounds 99 (-128y, 127y) =! actual From 0fff0cbfba059906732c83d453a851221f53d661 Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Tue, 19 Jan 2021 00:42:42 +0000 Subject: [PATCH 4/5] Add range combinator --- doc/tutorial.md | 12 ++++++------ src/Hedgehog/Gen.fs | 10 +++++----- src/Hedgehog/Range.fs | 7 +++++++ tests/Hedgehog.Tests/MinimalTests.fs | 5 +++-- 4 files changed, 21 insertions(+), 13 deletions(-) diff --git a/doc/tutorial.md b/doc/tutorial.md index 529f4581..0263aa40 100644 --- a/doc/tutorial.md +++ b/doc/tutorial.md @@ -630,8 +630,8 @@ let tryAdd a b = if a > 100 then None // Nasty bug. else Some (a + b) -property { let! a = Gen.int (Range.constantBounded ()) - let! b = Gen.int (Range.constantBounded ()) +property { let! a = Range.constantBounded () |> Gen.int + let! b = Range.constantBounded () |> Gen.int return tryAdd a b = Some (a + b) } |> Property.print;; @@ -657,8 +657,8 @@ let tryAdd a b = if a > 100 then None // Nasty bug. else Some(a + b) -property { let! a = Gen.int (Range.constantBounded ()) - let! b = Gen.int (Range.constantBounded ()) +property { let! a = Range.constantBounded () |> Gen.int + let! b = Range.constantBounded () |> Gen.int counterexample (sprintf "The value of a was %d." a) return tryAdd a b = Some(a + b) } |> Property.print;; @@ -680,8 +680,8 @@ let tryAdd a b = if a > 100 then None // Nasty bug. else Some(a + b) -property { let! a = Gen.int (Range.constantBounded ()) - let! b = Gen.int (Range.constantBounded ()) +property { let! a = Range.constantBounded () |> Gen.int + let! b = Range.constantBounded () |> Gen.int where (a < 100) return tryAdd a b = Some(a + b) } |> Property.print;; diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index db74def7..1e8401c1 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -183,7 +183,7 @@ module Gen = if Array.isEmpty xs then return crashEmpty "xs" else - let! ix = integral (Range.constant 0 (Array.length xs - 1)) + let! ix = Range.ofArray xs |> integral return Array.item ix xs } @@ -206,7 +206,7 @@ module Gen = else pick (n - k) ys - let! n = integral (Range.constant 1 total) + let! n = Range.constant 1 total |> integral return! pick n xs } @@ -217,7 +217,7 @@ module Gen = if Array.isEmpty xs then return crashEmpty "xs" xs else - let! ix = integral (Range.constant 0 (Array.length xs - 1)) + let! ix = Range.ofArray xs |> integral return! Array.item ix xs } @@ -277,7 +277,7 @@ module Gen = let tryFilter (p : 'a -> bool) (g : Gen<'a>) : Gen<'a option> = let filter = function | None -> - Random.constant (Tree.singleton None) + Tree.singleton None |> Random.constant | Some x -> Random.constant (Tree.map Some x) @@ -450,7 +450,7 @@ module Gen = /// Generates a random globally unique identifier. let guid : Gen = gen { - let! bs = array (Range.singleton 16) (byte (Range.constantBounded ())) + let! bs = Range.constantBounded () |> byte |> array (Range.singleton 16) return Guid bs } diff --git a/src/Hedgehog/Range.fs b/src/Hedgehog/Range.fs index 9af57fba..aa91fc86 100644 --- a/src/Hedgehog/Range.fs +++ b/src/Hedgehog/Range.fs @@ -81,6 +81,13 @@ module Range = constantFrom zero lo hi + // + // Factories + // + + let internal ofArray (xs : 'a array) = + constant 0 (Array.length xs - 1) + // // Combinators - Linear // diff --git a/tests/Hedgehog.Tests/MinimalTests.fs b/tests/Hedgehog.Tests/MinimalTests.fs index 9e547107..672f2343 100644 --- a/tests/Hedgehog.Tests/MinimalTests.fs +++ b/tests/Hedgehog.Tests/MinimalTests.fs @@ -64,8 +64,9 @@ let rec genExp : Gen = App Gen.zip genExp genExp ] - let choiceRec = Gen.choiceRec recs nonrecs - Gen.shrink shrinkExp choiceRec) // comment this out to see the property fail + Gen.choiceRec recs nonrecs + |> Gen.shrink shrinkExp // comment this out to see the property fail + ) [] let ``greedy traversal with a predicate yields the perfect minimal shrink``() = From 12e8f747c3c7dc5ca5f8b63fdc06de7cee878c34 Mon Sep 17 00:00:00 2001 From: adam-becker <47185607+adam-becker@users.noreply.github.com> Date: Tue, 19 Jan 2021 13:06:42 -0700 Subject: [PATCH 5/5] Update src/Hedgehog/Range.fs Co-authored-by: Nikos Baxevanis --- src/Hedgehog/Range.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Hedgehog/Range.fs b/src/Hedgehog/Range.fs index aa91fc86..c9e5c306 100644 --- a/src/Hedgehog/Range.fs +++ b/src/Hedgehog/Range.fs @@ -85,7 +85,7 @@ module Range = // Factories // - let internal ofArray (xs : 'a array) = + let internal ofArray (xs : 'a array) : Range = constant 0 (Array.length xs - 1) //