diff --git a/CHANGELOG.md b/CHANGELOG.md index 0a178a59..2c8bb0f7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,7 @@ - Add `Tree.apply`. Change `Gen.apply` from monadic to applicative. Revert runtime optimization of `Gen.integral`. ([#398][398], [@TysonMN][TysonMN]) - Change `ListGen.traverse` from monadic to applicative. ([#399][399], [@TysonMN][TysonMN]) - Fix bug in the `BindReturn` method of the `property` CE where the generated value is not added to the Journal. ([#401][401], [@TysonMN][TysonMN]) +- Add `BindReturn` to the `gen` CE. This essentially changes the last call to `let!` to use `Gen.map` instead of `Gen.bind`. Add `MergeSources` to the `gen` and `property` CEs. This change enables the `and!` syntax. ([#400][400], [@TysonMN][TysonMN]) ## Version 0.12.0 (2021-12-12) @@ -193,6 +194,8 @@ [401]: https://github.com/hedgehogqa/fsharp-hedgehog/pull/401 +[400]: + https://github.com/hedgehogqa/fsharp-hedgehog/pull/400 [399]: https://github.com/hedgehogqa/fsharp-hedgehog/pull/399 [398]: diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index 1a1512af..f525e511 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -103,6 +103,8 @@ module Gen = constant () member __.Return(a) : Gen<'a> = constant a member __.ReturnFrom(g) : Gen<'a> = g + member __.BindReturn(g, f) = map f g + member __.MergeSources(ga, gb) = zip ga gb member __.Bind(g, f) = g |> bind f member __.For(xs, k) = let xse = (xs :> seq<'a>).GetEnumerator () diff --git a/src/Hedgehog/Property.fs b/src/Hedgehog/Property.fs index 2b7afe18..08473357 100644 --- a/src/Hedgehog/Property.fs +++ b/src/Hedgehog/Property.fs @@ -330,6 +330,9 @@ module PropertyBuilder = |> Property.ofGen |> Property.map f + member __.MergeSources(ga, gb) = + Gen.zip ga gb + member __.ReturnFrom(m : Property<'a>) : Property<'a> = m diff --git a/tests/Hedgehog.Tests/GenTests.fs b/tests/Hedgehog.Tests/GenTests.fs index 6c65e467..995217ee 100644 --- a/tests/Hedgehog.Tests/GenTests.fs +++ b/tests/Hedgehog.Tests/GenTests.fs @@ -5,6 +5,50 @@ open Hedgehog open Hedgehog.Gen.Operators open TestDsl + +let private testGenPairViaApply gPair = + // In addition to asserting that Gen.apply is applicative, this code + // also asserts that the integral shrink tree is the one containing + // duplicates that existed before PR + // https://github.com/hedgehogqa/fsharp-hedgehog/pull/239 + // The duplicate-free shrink trees that result from the code in that PR + // do not work well with the applicative behavior of Gen.apply because + // some values would shrink more if using the monadic version of + // Gen.apply, which should never happen. + let actual = + seq { + while true do + let t = gPair |> Gen.sampleTree 0 1 |> Seq.head + if Tree.outcome t = (2, 1) then + yield t + } |> Seq.head + + let expected = + Node ((2, 1), [ + Node ((0, 1), [ + Node ((0, 0), []) + ]) + Node ((1, 1), [ + Node ((0, 1), [ + Node ((0, 0), []) + ]) + Node ((1, 0), [ + Node ((0, 0), []) + ]) + ]) + Node ((2, 0), [ + Node ((0, 0), []) + Node ((1, 0), [ + Node ((0, 0), []) + ]) + ]) + ]) + + (actual |> Tree.map (sprintf "%A") |> Tree.render) + =! (expected |> Tree.map (sprintf "%A") |> Tree.render) + Expect.isTrue <| Tree.equals actual expected + + let genTests = testList "Gen tests" [ yield! testCases "dateTime creates DateTime instances" [ 8; 16; 32; 64; 128; 256; 512 ] <| fun count-> @@ -37,21 +81,23 @@ let genTests = testList "Gen tests" [ [] =! List.filter (fun ch -> ch = char nonchar) actual testCase "dateTime randomly generates value between max and min ticks" <| fun _ -> - let seed0 = Seed.random () - let (seed1, _) = Seed.split seed0 + // This is a bad test because essentially the same logic used to + // implement Gen.dateTime appears in this test. However, keeping it for + // now. + let seed = Seed.random () let range = Range.constant DateTime.MinValue.Ticks DateTime.MaxValue.Ticks let ticks = Random.integral range - |> Random.run seed1 0 + |> Random.run seed 0 let actual = Range.constant DateTime.MinValue DateTime.MaxValue |> Gen.dateTime |> Gen.toRandom - |> Random.run seed0 0 + |> Random.run seed 0 |> Tree.outcome let expected = DateTime ticks @@ -135,51 +181,20 @@ let genTests = testList "Gen tests" [ } |> Property.check - testCase "apply is applicative" <| fun () -> - // In addition to asserting that Gen.apply is applicative, this test - // also asserts that the integral shrink tree is the one containing - // duplicates that existed before PR - // https://github.com/hedgehogqa/fsharp-hedgehog/pull/239 - // The duplicate-free shrink trees that result from the code in that PR - // do not work well with the applicative behavior of Gen.apply because - // some values would shrink more if using the monadic version of - // Gen.apply, which should never happen. + testCase "apply is applicative via function" <| fun () -> let gPair = Gen.constant (fun a b -> a, b) |> Gen.apply (Range.constant 0 2 |> Gen.int32) |> Gen.apply (Range.constant 0 1 |> Gen.int32) + testGenPairViaApply gPair - let actual = - seq { - while true do - let t = gPair |> Gen.sampleTree 0 1 |> Seq.head - if Tree.outcome t = (2, 1) then - yield t - } |> Seq.head - - let expected = - Node ((2, 1), [ - Node ((0, 1), [ - Node ((0, 0), []) - ]) - Node ((1, 1), [ - Node ((0, 1), [ - Node ((0, 0), []) - ]) - Node ((1, 0), [ - Node ((0, 0), []) - ]) - ]) - Node ((2, 0), [ - Node ((0, 0), []) - Node ((1, 0), [ - Node ((0, 0), []) - ]) - ]) - ]) - - (actual |> Tree.map (sprintf "%A") |> Tree.render) - =! (expected |> Tree.map (sprintf "%A") |> Tree.render) - Expect.isTrue <| Tree.equals actual expected + testCase "apply is applicative via CE" <| fun () -> + let gPair = + gen { + let! a = Range.constant 0 2 |> Gen.int32 + and! b = Range.constant 0 1 |> Gen.int32 + return a, b + } + testGenPairViaApply gPair ] diff --git a/tests/Hedgehog.Tests/PropertyTests.fs b/tests/Hedgehog.Tests/PropertyTests.fs index 63e4cb86..95241400 100644 --- a/tests/Hedgehog.Tests/PropertyTests.fs +++ b/tests/Hedgehog.Tests/PropertyTests.fs @@ -110,4 +110,25 @@ let propertyTests = testList "Property tests" [ actual =! "false" + testCase "and! syntax is applicative" <| fun () -> + // Based on https://well-typed.com/blog/2019/05/integrated-shrinking/#:~:text=For%20example%2C%20consider%20the%20property%20that + let actual = + property { + let! x = Range.constant 0 1_000_000_000 |> Gen.int32 + and! y = Range.constant 0 1_000_000_000 |> Gen.int32 + return x <= y |> Expect.isTrue + } + |> Property.report + |> Report.render + |> (fun x -> x.Split ([|Environment.NewLine|], StringSplitOptions.None)) + |> Array.item 1 + + let actual = + // normalize printing of a pair between .NET and Fable/JS + actual.Replace("(", "") + .Replace(" ", "") + .Replace(")", "") + + actual =! "1,0" + ]