diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json index 2b3f31cd..ad6bdc0c 100644 --- a/.devcontainer/devcontainer.json +++ b/.devcontainer/devcontainer.json @@ -7,7 +7,8 @@ "extensions": [ "editorconfig.editorconfig", - "ionide.ionide-fsharp@4.17.0" + "ionide.ionide-fsharp@4.17.0", + "ms-dotnettools.csharp@1.23.12" ], "settings": { diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index f4106050..6ea9cfef 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -4,16 +4,41 @@ open System /// A generator for values and shrink trees of type 'a. [] -type Gen<'a> = - | Gen of Random> +type Gen<'a> = private { + Config : GenConfig<'a> + Random : Random> +} module Gen = + module Config = + let get (gen : Gen<'a>) : GenConfig<'a> = + gen.Config - let ofRandom (r : Random>) : Gen<'a> = - Gen r + let map (f : GenConfig<'a> -> GenConfig<'a>) (gen : Gen<'a>) : Gen<'a> = + { gen with Config = f (get gen) } - let toRandom (Gen r : Gen<'a>) : Random> = - r + let set (config : GenConfig<'a>) (gen : Gen<'a>) : Gen<'a> = + map (always config) gen + + let format (a : 'a) (gen : Gen<'a>) : string = + let formatter = gen |> Config.get |> GenConfig.getFormatter + formatter a + + let withFormatter (formatter : 'a -> string) (gen : Gen<'a>) : Gen<'a> = + gen + |> Config.map (GenConfig.setFormatter formatter) + + let withListFormatter (gen : Gen<_>) : Gen<_> = + gen + |> withFormatter (Seq.toList >> sprintf "%A") + + let ofRandom (random : Random>) : Gen<'a> = { + Config = GenConfig.defaultConfig + Random = random + } + + let toRandom (gen : Gen<'a>) : Random> = + gen.Random let delay (f : unit -> Gen<'a>) : Gen<'a> = Random.delay (toRandom << f) |> ofRandom @@ -343,6 +368,12 @@ module Gen = Random.sized sizedList |> ofRandom + /// Generates a `System.Collections.Generic.List` using a 'Range' to determine the length. + let resizeArray (range : Range) (g : Gen<'a>) : Gen> = + list range g + |> map ResizeArray + |> withListFormatter + /// Generates an array using a 'Range' to determine the length. let array (range : Range) (g : Gen<'a>) : Gen> = list range g |> map Array.ofList diff --git a/src/Hedgehog/GenConfig.fs b/src/Hedgehog/GenConfig.fs new file mode 100644 index 00000000..f7122bc9 --- /dev/null +++ b/src/Hedgehog/GenConfig.fs @@ -0,0 +1,17 @@ +namespace Hedgehog + +type GenConfig<'a> = private { + Formatter : 'a -> string +} + +module GenConfig = + + let defaultConfig<'a> = + let formatter: 'a -> string = sprintf "%A" + { Formatter = formatter } + + let getFormatter (config : GenConfig<'a>) : ('a -> string) = + config.Formatter + + let setFormatter (formatter : 'a -> string) (config : GenConfig<'a>) : GenConfig<'a> = + { config with Formatter = formatter } diff --git a/src/Hedgehog/Hedgehog.fsproj b/src/Hedgehog/Hedgehog.fsproj index 0e2e614e..fddf501f 100644 --- a/src/Hedgehog/Hedgehog.fsproj +++ b/src/Hedgehog/Hedgehog.fsproj @@ -37,6 +37,7 @@ https://github.com/hedgehogqa/fsharp-hedgehog/blob/master/doc/index.md + diff --git a/src/Hedgehog/Linq/Gen.fs b/src/Hedgehog/Linq/Gen.fs index 02222f30..b4ac4dfe 100644 --- a/src/Hedgehog/Linq/Gen.fs +++ b/src/Hedgehog/Linq/Gen.fs @@ -162,8 +162,7 @@ type GenExtensions private () = [] static member List (gen : Gen<'T>, range : Range) : Gen> = - Gen.list range gen - |> Gen.map ResizeArray + Gen.resizeArray range gen [] static member NoShrink (gen : Gen<'T>) : Gen<'T> = @@ -292,6 +291,14 @@ type GenExtensions private () = static member Where (gen : Gen<'T>, predicate : Func<'T, bool>) : Gen<'T> = Gen.filter predicate.Invoke gen + [] + static member WithFormatter (gen : Gen<'T>, formatter : Func<'T, string>) = + Gen.withFormatter formatter.Invoke gen + + [] + static member WithListFormatter (gen : Gen>) = + Gen.withListFormatter gen + [] static member Zip (genA : Gen<'T>, genB : Gen<'U>) : Gen<'T * 'U> = Gen.zip genA genB diff --git a/src/Hedgehog/Property.fs b/src/Hedgehog/Property.fs index 7d493e37..9529ec5f 100644 --- a/src/Hedgehog/Property.fs +++ b/src/Hedgehog/Property.fs @@ -98,26 +98,9 @@ module Property = |> bindGen kTry |> ofGen - let private printValue (value) : string = - // sprintf "%A" is not prepared for printing ResizeArray<_> (C# List) so we prepare the value instead - let prepareForPrinting (value: obj) : obj = - #if FABLE_COMPILER - value - #else - let t = value.GetType() - // have to use TypeInfo due to targeting netstandard 1.6 - let t = System.Reflection.IntrospectionExtensions.GetTypeInfo(t) - let isList = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> - if isList - then value :?> System.Collections.IEnumerable |> Seq.cast |> List.ofSeq :> obj - else value - #endif - - value |> prepareForPrinting |> sprintf "%A" - let forAll (k : 'a -> Property<'b>) (gen : Gen<'a>) : Property<'b> = let prepend (x : 'a) = - counterexample (fun () -> printValue x) + counterexample (fun () -> gen |> Gen.format x) |> set x |> bind k |> toGen diff --git a/tests/Hedgehog.Tests/PropertyTests.fs b/tests/Hedgehog.Tests/PropertyTests.fs index 66041a5a..c606d8c1 100644 --- a/tests/Hedgehog.Tests/PropertyTests.fs +++ b/tests/Hedgehog.Tests/PropertyTests.fs @@ -8,7 +8,18 @@ let propertyTests = testList "Property tests" [ fableIgnore "generated C# list of five elements is not abbreviated in the failure report" <| fun _ -> let report = property { - let! xs = Range.singleton 0 |> Gen.int32 |> Gen.list (Range.singleton 5) |> Gen.map ResizeArray + let gen = Gen.int32 (Range.singleton 0) + let! xs = Gen.resizeArray (Range.singleton 5) gen + return false + } + |> Property.renderWith (PropertyConfig.withShrinks 0 PropertyConfig.defaultConfig) + Expect.isNotMatch report "\.\.\." "Abbreviation (...) found" + + fableIgnore "generated seq of five elements converted to C# list is not abbreviated in the failure report" <| fun _ -> + let report = + property { + let gen = Gen.int32 (Range.singleton 0) + let! xs = Gen.seq (Range.singleton 5) gen |> Gen.map ResizeArray |> Gen.withListFormatter return false } |> Property.renderWith (PropertyConfig.withShrinks 0 PropertyConfig.defaultConfig)