From 56ed0ce1f39c370537558f6cc33589a6f3bc1a6f Mon Sep 17 00:00:00 2001 From: Nikos Baxevanis Date: Wed, 3 Feb 2021 15:59:44 +0100 Subject: [PATCH] Housekeeping --- tests/Hedgehog.Tests/GenTests.fs | 65 +++++++++++++++++++---------- tests/Hedgehog.Tests/Program.fs | 2 - tests/Hedgehog.Tests/RangeTests.fs | 1 - tests/Hedgehog.Tests/SeedTests.fs | 11 +++-- tests/Hedgehog.Tests/ShrinkTests.fs | 14 +++---- tests/Hedgehog.Tests/TestDsl.fs | 43 +++++++++---------- tests/Hedgehog.Tests/TreeTests.fs | 7 ++-- 7 files changed, 78 insertions(+), 65 deletions(-) diff --git a/tests/Hedgehog.Tests/GenTests.fs b/tests/Hedgehog.Tests/GenTests.fs index f39625a2..b30b1cf7 100644 --- a/tests/Hedgehog.Tests/GenTests.fs +++ b/tests/Hedgehog.Tests/GenTests.fs @@ -1,68 +1,91 @@ module Hedgehog.Tests.GenTests +open System open Hedgehog open Hedgehog.Gen.Operators open TestDsl let genTests = testList "Gen tests" [ - yield! testCases "dateTime creates System.DateTime instances" [ 8; 16; 32; 64; 128; 256; 512 ] <| fun count-> - let actual = Gen.dateTime (Range.constant System.DateTime.MinValue System.DateTime.MaxValue) |> Gen.sample 0 count + yield! testCases "dateTime creates DateTime instances" + [ 8; 16; 32; 64; 128; 256; 512 ] <| fun count-> + + let actual = + (Range.constant + DateTime.MinValue + DateTime.MaxValue) + |> Gen.dateTime + |> Gen.sample 0 count + actual |> List.distinct |> List.length =! actual.Length testCase "unicode doesn't return any surrogate" <| fun _ -> - let actual = Gen.sample 100 100000 Gen.unicode - [] =! List.filter System.Char.IsSurrogate actual + let actual = + Gen.sample 100 100000 Gen.unicode + [] =! List.filter Char.IsSurrogate actual + + yield! testCases "unicode doesn't return any noncharacter" + [ 65534; 65535 ] <| fun nonchar -> - yield! testCases "unicode doesn't return any noncharacter" [ 65534; 65535 ] <| fun nonchar -> - let actual = Gen.sample 100 100000 Gen.unicode + let actual = + Gen.sample 100 100000 Gen.unicode [] =! List.filter (fun ch -> ch = char nonchar) actual testCase "dateTime randomly generates value between max and min ticks" <| fun _ -> - let seed0 = Seed.random() + let seed0 = Seed.random () let (seed1, _) = Seed.split seed0 let range = Range.constant - System.DateTime.MinValue.Ticks - System.DateTime.MaxValue.Ticks + DateTime.MinValue.Ticks + DateTime.MaxValue.Ticks let ticks = Random.integral range |> Random.run seed1 0 - let expected = System.DateTime ticks - let actual = Gen.dateTime (Range.constant System.DateTime.MinValue System.DateTime.MaxValue) + let actual = + Range.constant DateTime.MinValue DateTime.MaxValue + |> Gen.dateTime + |> Gen.toRandom + |> Random.run seed0 0 + |> Tree.outcome - let result = actual |> Gen.toRandom |> Random.run seed0 0 |> Tree.outcome - expected =! result + let expected = + DateTime ticks + expected =! actual testCase "dateTime shrinks to correct mid-value" <| fun _ -> - let result = + let actual = property { let! actual = - Range.constantFrom (System.DateTime (2000, 1, 1)) System.DateTime.MinValue System.DateTime.MaxValue + (Range.constantFrom + (DateTime (2000, 1, 1)) + DateTime.MinValue + DateTime.MaxValue) |> Gen.dateTime - System.DateTime.Now =! actual + DateTime.Now =! actual } |> Property.report |> Report.render - |> (fun x -> x.Split ([|System.Environment.NewLine|], System.StringSplitOptions.None)) + |> (fun x -> x.Split ([|Environment.NewLine|], StringSplitOptions.None)) |> Array.item 1 - |> System.DateTime.Parse - System.DateTime (2000, 1, 1) =! result + |> DateTime.Parse - testCaseNoFable "int64 can create exponentially bounded integer" <| fun _ -> + DateTime (2000, 1, 1) =! actual + + fableIgnore "int64 can create exponentially bounded integer" <| fun _ -> Property.check (property { let! _ = Gen.int64 (Range.exponentialBounded ()) return true }) - testCaseNoFable "uint64 can create exponentially bounded integer" <| fun _ -> + fableIgnore "uint64 can create exponentially bounded integer" <| fun _ -> Property.check (property { let! _ = Gen.uint64 (Range.exponentialBounded ()) return true }) + testCase "apply is chainable" <| fun _ -> let _ : Gen = Gen.constant (+) diff --git a/tests/Hedgehog.Tests/Program.fs b/tests/Hedgehog.Tests/Program.fs index b9081aba..e7be2b49 100644 --- a/tests/Hedgehog.Tests/Program.fs +++ b/tests/Hedgehog.Tests/Program.fs @@ -1,6 +1,5 @@ module Hedgehog.Tests.Main -open Hedgehog open TestDsl #if !FABLE_COMPILER @@ -16,7 +15,6 @@ let allTests = testList "All tests" [ MinimalTests.minimalTests ] - [] let main (args: string[]) = #if FABLE_COMPILER diff --git a/tests/Hedgehog.Tests/RangeTests.fs b/tests/Hedgehog.Tests/RangeTests.fs index fbc3a1e5..a5534022 100644 --- a/tests/Hedgehog.Tests/RangeTests.fs +++ b/tests/Hedgehog.Tests/RangeTests.fs @@ -244,5 +244,4 @@ let rangeTests = testList "Range tests" [ |> Range.bounds 99 (-128y, 127y) =! actual - ] diff --git a/tests/Hedgehog.Tests/SeedTests.fs b/tests/Hedgehog.Tests/SeedTests.fs index 48d467a6..4cea0c40 100644 --- a/tests/Hedgehog.Tests/SeedTests.fs +++ b/tests/Hedgehog.Tests/SeedTests.fs @@ -4,9 +4,8 @@ open Hedgehog open TestDsl let seedTests = testList "Seed tests" [ - + // https://github.com/hedgehogqa/haskell-hedgehog/commit/39b15b9b4d147f6001984c4b7edab00878269da7 yield! testCases "Seed.from 'fixes' the γ-value" - // https://github.com/hedgehogqa/haskell-hedgehog/commit/39b15b9b4d147f6001984c4b7edab00878269da7 [ (0x61c8864680b583ebUL, 15210016002011668638UL, 12297829382473034411UL) (0xf8364607e9c949bdUL, 11409286845259996466UL, 12297829382473034411UL) (0x88e48f4fcc823718UL, 1931727433621677744UL, 12297829382473034411UL) @@ -24,8 +23,8 @@ let seedTests = testList "Seed tests" [ (0x05d507d05e785673UL, 1471112649570176389UL, 12297829382473034421UL) (0x76442b62dddf926cUL, 8100917074368564322UL, 12297829382473034421UL) ] <| fun (x, value, gamma) -> - { Value = value - Gamma = gamma } - =! Seed.from x - + let expected = + { Value = value + Gamma = gamma } + expected =! Seed.from x ] diff --git a/tests/Hedgehog.Tests/ShrinkTests.fs b/tests/Hedgehog.Tests/ShrinkTests.fs index 2d2815bd..53fcb091 100644 --- a/tests/Hedgehog.Tests/ShrinkTests.fs +++ b/tests/Hedgehog.Tests/ShrinkTests.fs @@ -12,7 +12,7 @@ let shrinkTests = testList "Shrink tests" [ [ 1; 2; 5; 6 ] [ 1; 2; 3; 4 ] ] // http://stackoverflow.com/a/17101488 - Expect.isTrue ( Seq.fold (&&) true (Seq.zip expected actual |> Seq.map (fun (a, b) -> a = b)) ) + Expect.isTrue (Seq.fold (&&) true (Seq.zip expected actual |> Seq.map (fun (a, b) -> a = b))) testCase "removes produces all permutations of removing 'k' elements from a list - example 1" <| fun _ -> let actual = @@ -116,14 +116,14 @@ let shrinkTests = testList "Shrink tests" [ [ 1; 2; 3; 30; 128; 256; 512; 1024 ] <| fun n -> let xs = [ 1 .. n ] let actual = Shrink.list xs |> Seq.toList - Expect.isTrue ( actual |> List.forall (fun xs' -> xs.Length > xs'.Length) ) + Expect.isTrue (actual |> List.forall (fun xs' -> xs.Length > xs'.Length)) yield! testCases "elems shrinks each element in input list using a supplied shrinker" [ 1; 2; 3; 30; 128; 256; 512; 1024 ] <| fun n -> let xs = [ 1..n ] let shrinker = fun x -> - Expect.isTrue ( List.contains x xs ) + Expect.isTrue (List.contains x xs) Seq.singleton x let actual = @@ -151,7 +151,7 @@ let shrinkTests = testList "Shrink tests" [ x0 |> Shrink.towards destination |> Seq.toList - Expect.isTrue ( actual |> List.forall (fun x1 -> x1 < x0 && x1 >= destination) ) + Expect.isTrue (actual |> List.forall (fun x1 -> x1 < x0 && x1 >= destination)) yield! testCases "towards returns empty list when run out of shrinks" [ ( 1, 1) @@ -162,7 +162,7 @@ let shrinkTests = testList "Shrink tests" [ x0 |> Shrink.towards destination |> Seq.toList - Expect.isTrue ( actual |> List.isEmpty ) + Expect.isTrue (actual |> List.isEmpty) yield! testCases "towardsDouble shrinks by edging towards a destination number" [ ( 2.0, 1.0) @@ -177,7 +177,7 @@ let shrinkTests = testList "Shrink tests" [ x0 |> Shrink.towardsDouble destination |> Seq.toList - Expect.isTrue ( actual |> List.forall (fun x1 -> x1 < x0 && x1 >= destination) ) + Expect.isTrue (actual |> List.forall (fun x1 -> x1 < x0 && x1 >= destination)) yield! testCases "towardsDouble returns empty list when run out of shrinks" [ ( 1.0, 1.0) @@ -188,7 +188,7 @@ let shrinkTests = testList "Shrink tests" [ x0 |> Shrink.towards destination |> Seq.toList - Expect.isTrue ( actual |> List.isEmpty ) + Expect.isTrue (actual |> List.isEmpty) yield! testCases "Property.reportWith respects shrinkLimit" [ 0; 1; 2 ] <| fun shrinkLimit -> diff --git a/tests/Hedgehog.Tests/TestDsl.fs b/tests/Hedgehog.Tests/TestDsl.fs index 68ba89e5..716bb67e 100644 --- a/tests/Hedgehog.Tests/TestDsl.fs +++ b/tests/Hedgehog.Tests/TestDsl.fs @@ -1,43 +1,38 @@ -module Hedgehog.Tests.TestDsl +module internal Hedgehog.Tests.TestDsl #if FABLE_COMPILER - open Fable.Mocha -// Alias test functions so we do not have to deal with different open statements in every test file. -let testCase = Fable.Mocha.Test.testCase -let ptestCase = Fable.Mocha.Test.ptestCase -let testList = Fable.Mocha.Test.testList +let testCase = Test.testCase +let ptestCase = Test.ptestCase +let testList = Test.testList #else - open Expecto -// Alias test functions so we do not have to deal with different open statements in every test file. -let testCase = Expecto.Tests.testCase -let ptestCase = Expecto.Tests.ptestCase -let testList = Expecto.Tests.testList +let testCase = Tests.testCase +let ptestCase = Tests.ptestCase +let testList = Tests.testList +type TestCase = Test #endif -let inline testCases name testData testFun = - let nameWithData name data = sprintf "%s: (%A)" name data - - [ for data in testData do - testCase (nameWithData name data) (fun _ -> - testFun data) ] +let testCases (label : string) (xs : seq<'a>) (f : 'a -> unit) : List = + [ for x in xs do + testCase (sprintf "%s: (%A)" label x) (fun _ -> f x) ] -/// Some tests are not running in javascript world. -/// Use this to ignore such tests. -let testCaseNoFable name testFun = +let fableIgnore (label : string) (test : unit -> unit) : TestCase = #if FABLE_COMPILER - ptestCase name testFun + // Some tests are not running in Node.js. + ptestCase label test #else - testCase name testFun + testCase label test #endif -let inline (=!) actual expected = Expect.equal expected actual "Should be equal" +let inline (=!) (actual : 'a) (expected : 'a) : unit = + Expect.equal expected actual "Should be equal" [] module Expect = - let inline isTrue value = Expect.isTrue value "Should be true" + let isTrue value = + Expect.isTrue value "Should be true" diff --git a/tests/Hedgehog.Tests/TreeTests.fs b/tests/Hedgehog.Tests/TreeTests.fs index a077683d..fd2268ff 100644 --- a/tests/Hedgehog.Tests/TreeTests.fs +++ b/tests/Hedgehog.Tests/TreeTests.fs @@ -7,7 +7,6 @@ let treeTests = testList "Tree tests" [ testCase "render tree with depth 0" <| fun _ -> Property.check (property { let! x0 = Gen.constant "0" - let tree = Node (x0, [ ]) @@ -16,7 +15,7 @@ let treeTests = testList "Tree tests" [ let expected = [ sprintf "%A" x0 ] - Expect.isTrue ( expected = Tree.renderList tree ) + Expect.isTrue (expected = Tree.renderList tree) }) testCase "render tree with depth 1" <| fun _ -> @@ -40,7 +39,7 @@ let treeTests = testList "Tree tests" [ sprintf "├-%A" x2 sprintf "└-%A" x3 ] - Expect.isTrue ( expected = Tree.renderList tree ) + Expect.isTrue (expected = Tree.renderList tree) }) testCase "render tree with depth 2" <| fun _ -> @@ -94,6 +93,6 @@ let treeTests = testList "Tree tests" [ sprintf " ├-%A" x11 sprintf " └-%A" x12 ] - Expect.isTrue ( expected = Tree.renderList tree ) + Expect.isTrue (expected = Tree.renderList tree) }) ]