diff --git a/.gitignore b/.gitignore index ff37384..92150ba 100644 --- a/.gitignore +++ b/.gitignore @@ -48,4 +48,7 @@ Thumbs.db # Paket - dependency management for .NET and Mono projects .paket/paket.bootstrapper.run .paket/paket.exe -paket-files \ No newline at end of file +paket-files + +# Visual Studio cache/options directory +.vs/ \ No newline at end of file diff --git a/src/Hedgehog.Experimental/Gen.fs b/src/Hedgehog.Experimental/Gen.fs index 1bcd2d5..db6172a 100644 --- a/src/Hedgehog.Experimental/Gen.fs +++ b/src/Hedgehog.Experimental/Gen.fs @@ -1,96 +1,98 @@ -module Hedgehog.Gen +namespace Hedgehog - open Hedgehog.Gen +open TypeShape +open System +module GenX = /// Shortcut for Gen.list (Range.exponential lower upper). let eList (lower : int) (upper : int) : (Gen<'a> -> Gen>) = - list (Range.exponential lower upper) + Gen.list (Range.exponential lower upper) /// Shortcut for Gen.list (Range.linear lower upper). let lList (lower : int) (upper : int) : (Gen<'a> -> Gen>) = - list (Range.linear lower upper) + Gen.list (Range.linear lower upper) /// Shortcut for Gen.list (Range.constant lower upper). let cList (lower : int) (upper : int) : (Gen<'a> -> Gen>) = - list (Range.constant lower upper) + Gen.list (Range.constant lower upper) /// Shortcut for Gen.string (Range.exponential lower upper). let eString (lower : int) (upper : int) : (Gen -> Gen) = - string (Range.exponential lower upper) + Gen.string (Range.exponential lower upper) /// Shortcut for Gen.string (Range.linear lower upper). let lString (lower : int) (upper : int) : (Gen -> Gen) = - string (Range.linear lower upper) + Gen.string (Range.linear lower upper) /// Shortcut for Gen.string (Range.constant lower upper). let cString (lower : int) (upper : int) : (Gen -> Gen) = - string (Range.constant lower upper) + Gen.string (Range.constant lower upper) /// Generates null part of the time. let withNull (g : Gen<'a>) : Gen<'a> = - g |> option |> map (fun xOpt -> + g |> Gen.option |> Gen.map (fun xOpt -> match xOpt with Some x -> x | None -> null) /// Generates a value that is not null. let noNull (g : Gen<'a>) : Gen<'a> = - g |> filter (not << isNull) + g |> Gen.filter (not << isNull) /// Generates a value that is not equal to another value. let notEqualTo (other : 'a) : (Gen<'a> -> Gen<'a>) = - filter ((<>) other) + Gen.filter ((<>) other) /// Generates a value that is not equal to another option-wrapped value. let notEqualToOpt (other : 'a option) : (Gen<'a> -> Gen<'a>) = - filter (fun x -> match other with Some o -> x <> o | None -> true) + Gen.filter (fun x -> match other with Some o -> x <> o | None -> true) /// Generates a value that is not contained in the specified list. let notIn (list: 'a list) (g : Gen<'a>) : Gen<'a> = - g |> filter (fun x -> not <| List.contains x list) + g |> Gen.filter (fun x -> not <| List.contains x list) /// Generates a list that does not contain the specified element. /// Shortcut for Gen.filter (not << List.contains x) let notContains (x: 'a) : (Gen<'a list> -> Gen<'a list>) = - filter (not << List.contains x) + Gen.filter (not << List.contains x) /// Inserts the given element at a random place in the list let addElement (x : 'a) (g : Gen<'a list>) : Gen<'a list> = gen { - let! xs = g - let! i = integral (Range.constant 0 xs.Length) - let l1, l2 = xs |> List.splitAt i - return List.concat [l1; [x]; l2] + let! xs = g + let! i = Gen.integral (Range.constant 0 xs.Length) + let l1, l2 = xs |> List.splitAt i + return List.concat [l1; [x]; l2] } /// Generates a 2-tuple with sorted elements. let sorted2 (g : Gen<'a * 'a>) : Gen<'a * 'a> = - g |> map (fun (x1, x2) -> + g |> Gen.map (fun (x1, x2) -> let l = [x1; x2] |> List.sort (l.Item 0, l.Item 1)) /// Generates a 3-tuple with sorted elements. let sorted3 (g : Gen<'a * 'a * 'a>) : Gen<'a * 'a * 'a> = - g |> map (fun (x1, x2, x3) -> + g |> Gen.map (fun (x1, x2, x3) -> let l = [x1; x2; x3] |> List.sort (l.Item 0, l.Item 1, l.Item 2)) /// Generates a 4-tuple with sorted elements. let sorted4 (g : Gen<'a * 'a * 'a * 'a>) : Gen<'a * 'a * 'a * 'a> = - g |> map (fun (x1, x2, x3, x4) -> + g |> Gen.map (fun (x1, x2, x3, x4) -> let l = [x1; x2; x3; x4] |> List.sort (l.Item 0, l.Item 1, l.Item 2, l.Item 3)) /// Generates a 2-tuple with distinct elements. let distinct2 (g : Gen<'a * 'a>) : Gen<'a * 'a> = - g |> filter (fun (x1, x2) -> x1 <> x2) + g |> Gen.filter (fun (x1, x2) -> x1 <> x2) /// Generates a 3-tuple with distinct elements. let distinct3 (g : Gen<'a * 'a * 'a>) : Gen<'a * 'a * 'a> = - g |> filter (fun (x1, x2, x3) -> + g |> Gen.filter (fun (x1, x2, x3) -> [x1; x2; x3] |> List.distinct = [x1; x2; x3]) /// Generates a 4-tuple with distinct elements. let distinct4 (g : Gen<'a * 'a * 'a * 'a>) : Gen<'a * 'a * 'a * 'a> = - g |> filter (fun (x1, x2, x3, x4) -> + g |> Gen.filter (fun (x1, x2, x3, x4) -> [x1; x2; x3; x4] |> List.distinct = [x1; x2; x3; x4]) /// Generates a 2-tuple with strictly increasing elements. @@ -108,18 +110,24 @@ /// Generates a tuple of datetimes where the range determines the minimum /// and maximum number of days apart. Positive numbers means the datetimes /// will be in increasing order, and vice versa. - let dateInterval (dayRange : Range) - : Gen = + let dateInterval (dayRange : Range) : Gen = gen { - let tickRange = + let! ticksApart = dayRange - |> Range.map (fun days -> - Operators.int64 days * System.TimeSpan.TicksPerDay) - let! ticksApart = integral tickRange - let! dt1 = dateTime |> filter (fun dt -> - dt.Ticks + ticksApart > System.DateTime.MinValue.Ticks - && dt.Ticks + ticksApart < System.DateTime.MaxValue.Ticks) - let dt2 = dt1.AddTicks ticksApart + |> Range.map + (fun days -> + Operators.int64 days * TimeSpan.TicksPerDay) + |> Gen.integral + + let! dt1 = + Gen.dateTime + |> Gen.filter + (fun dt -> + dt.Ticks + ticksApart > DateTime.MinValue.Ticks + && dt.Ticks + ticksApart < DateTime.MaxValue.Ticks) + let dt2 = + dt1.AddTicks ticksApart + return dt1, dt2 } @@ -134,7 +142,7 @@ gen { let! inputs = inpGen let inputsDistinct = inputs |> List.distinct - let! outputs = outGen |> list (Range.singleton inputsDistinct.Length) + let! outputs = outGen |> Gen.list (Range.singleton inputsDistinct.Length) let inOutMap = List.zip inputsDistinct outputs |> Map.ofList return inputs, (fun x -> inOutMap.Item x) } @@ -150,17 +158,188 @@ let withDistinctMapTo (outGen : Gen<'b>) (inpGen : Gen<'a list>) : Gen<'a list * ('a -> 'b)> = gen { - let rec distinctOutGen (xs : 'b list) (length : int) : Gen<'b list> = - gen { - if xs.Length = length then return xs - else - let! x = outGen |> notIn xs - return! distinctOutGen (x::xs) length - } - - let! inputs = inpGen - let inputsDistinct = inputs |> List.distinct - let! outputs = distinctOutGen [] inputsDistinct.Length - let inOutMap = List.zip inputsDistinct outputs |> Map.ofList - return inputs, (fun x -> inOutMap.Item x) + let rec distinctOutGen (xs : 'b list) (length : int) : Gen<'b list> = + gen { + if xs.Length = length then return xs + else + let! x = outGen |> notIn xs + return! distinctOutGen (x::xs) length + } + + let! inputs = inpGen + let inputsDistinct = inputs |> List.distinct + let! outputs = distinctOutGen [] inputsDistinct.Length + let inOutMap = List.zip inputsDistinct outputs |> Map.ofList + return inputs, (fun x -> inOutMap.Item x) + } + + [] + type AutoGenConfig = + {Byte: Gen + Int16: Gen + Int: Gen + Int64: Gen + Double: Gen + Decimal: Gen + Bool: Gen + Guid: Gen + Char: Gen + DateTime: Gen + String: Gen + DateTimeOffset: Gen + SeqRange: Range // range for lists, arrays, etc. + } + + let defaults = + {Byte = Gen.byte <| Range.exponentialBounded() + Int16 = Gen.int16 <| Range.exponentialBounded() + Int = Gen.int <| Range.exponentialBounded() + Int64 = Gen.int64 <| Range.exponentialBounded() + Double = Gen.double <| Range.exponentialBounded() + Decimal = Gen.double <| Range.exponentialBounded() |> Gen.map decimal + Bool = Gen.bool + Guid = Gen.guid + Char = Gen.latin1 + DateTime = Gen.dateTime + String = Gen.string (Range.linear 0 50) Gen.latin1 + DateTimeOffset = Gen.dateTime |> Gen.map System.DateTimeOffset + SeqRange = Range.exponential 0 50} + + let rec auto'<'T> (config:AutoGenConfig) : Gen<'T> = + let wrap (t : Gen<'a>) = + unbox> t + + let mkRandomMember (shape : IShapeWriteMember<'DeclaringType>) = + shape.Accept { + new IWriteMemberVisitor<'DeclaringType, Gen<'DeclaringType -> 'DeclaringType>> with + member __.Visit(shape : ShapeWriteMember<'DeclaringType, 'Field>) = + let rf = auto'<'Field>(config) + gen { let! f = rf + return fun dt -> shape.Inject dt f } } + + match TypeShape.Create<'T>() with + | Shape.Byte -> wrap config.Byte + | Shape.Int16 -> wrap config.Int16 + | Shape.Int32 -> wrap config.Int + | Shape.Int64 -> wrap config.Int64 + + | Shape.Double -> wrap config.Double + | Shape.Decimal -> wrap config.Decimal + + | Shape.Bool -> wrap config.Bool + | Shape.Guid -> wrap config.Guid + | Shape.Char -> wrap config.Char + | Shape.DateTime -> wrap config.DateTime + + | Shape.Unit -> wrap (Gen.constant ()) + + | Shape.String -> wrap config.String + | Shape.DateTimeOffset -> wrap config.DateTimeOffset + + | Shape.FSharpOption s -> + s.Accept { + new IFSharpOptionVisitor> with + member __.Visit<'t>() = + auto'<'t> config |> Gen.option |> wrap } + + | Shape.Array s when s.Rank = 1 -> + s.Accept { + new IArrayVisitor> with + member __.Visit<'t> _ = + auto'<'t> config |> Gen.array config.SeqRange |> wrap } + + | Shape.Array _ -> + raise (System.NotSupportedException("Can only generate arrays of rank 1")) + + | Shape.FSharpList s -> + s.Accept { + new IFSharpListVisitor> with + member __.Visit<'t> () = + auto'<'t> config |> Gen.list config.SeqRange |> wrap } + + | Shape.FSharpSet s -> + s.Accept { + new IFSharpSetVisitor> with + member __.Visit<'t when 't : comparison> () = + auto'<'t list> config + |> Gen.map Set.ofList + |> wrap } + + | Shape.FSharpMap s -> + s.Accept { + new IFSharpMapVisitor> with + member __.Visit<'k, 'v when 'k : comparison> () = + auto'<('k * 'v) list> config + |> Gen.map Map.ofList + |> wrap } + + | Shape.Tuple (:? ShapeTuple<'T> as shape) -> + let eGens = + shape.Elements + |> Array.map mkRandomMember + + gen { + let mutable target = shape.CreateUninitialized () + for eg in eGens do + let! u = eg + target <- u target + return target } + + | Shape.FSharpRecord (:? ShapeFSharpRecord<'T> as shape) -> + let fieldGen = + shape.Fields + |> Array.map mkRandomMember + + gen { + let mutable target = shape.CreateUninitialized () + for eg in fieldGen do + let! u = eg + target <- u target + return target + } + + | Shape.FSharpUnion (:? ShapeFSharpUnion<'T> as shape) -> + let caseFieldGen = + shape.UnionCases + |> Array.map (fun uc -> uc.Fields |> Array.map mkRandomMember) + + gen { + let! tag = Gen.integral <| Range.constant 0 (caseFieldGen.Length - 1) + let mutable u = shape.UnionCases.[tag].CreateUninitialized () + for f in caseFieldGen.[tag] do + let! uf = f + u <- uf u + return u + } + + | Shape.CliMutable (:? ShapeCliMutable<'T> as shape) -> + let propGen = shape.Properties |> Array.map mkRandomMember + gen { + let mutable target = shape.CreateUninitialized () + for ep in propGen do + let! up = ep + target <- up target + return target + } + + | Shape.Poco (:? ShapePoco<'T> as shape) -> + let bestCtor = + shape.Constructors + |> Seq.filter (fun c -> c.IsPublic) + |> Seq.sortBy (fun c -> c.Arity) + |> Seq.tryHead + + match bestCtor with + | None -> failwithf "Class %O lacking an appropriate ctor" typeof<'T> + | Some ctor -> + ctor.Accept { + new IConstructorVisitor<'T, Gen<'T>> with + member __.Visit<'CtorParams> (ctor : ShapeConstructor<'T, 'CtorParams>) = + let paramGen = auto'<'CtorParams> (config) + gen { let! args = paramGen + return ctor.Invoke args } } + + | _ -> raise (System.NotSupportedException ()) + + let auto<'T>() = auto'<'T>(defaults) diff --git a/tests/Hedgehog.Experimental.Tests/GenTests.fs b/tests/Hedgehog.Experimental.Tests/GenTests.fs index 558c0af..494814e 100644 --- a/tests/Hedgehog.Experimental.Tests/GenTests.fs +++ b/tests/Hedgehog.Experimental.Tests/GenTests.fs @@ -10,7 +10,7 @@ let ``notIn generates element that is not in list`` () = let! xs = Gen.int (Range.linearFrom 0 -100 100) |> Gen.list (Range.linear 1 10) - let! x = Gen.int (Range.linearFrom 0 -100 100) |> Gen.notIn xs + let! x = Gen.int (Range.linearFrom 0 -100 100) |> GenX.notIn xs return not <| List.contains x xs } @@ -21,18 +21,18 @@ let ``notContains generates list that does not contain element`` () = let! xs = Gen.int (Range.linearFrom 0 -100 100) |> Gen.list (Range.linear 1 10) - |> Gen.notContains x + |> GenX.notContains x return not <| List.contains x xs } [] let ``addElement generates a list with the specified element`` () = Property.check <| property { - let! x = Gen.int (Range.exponentialBounded()) + let! x = Gen.int (Range.exponentialBounded ()) let! xs = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.list (Range.linear 0 10) - |> Gen.addElement x + |> GenX.addElement x return List.contains x xs } @@ -40,9 +40,9 @@ let ``addElement generates a list with the specified element`` () = let ``sorted2 generates a sorted 2-tuple`` () = Property.check <| property { let! x1, x2 = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.tuple - |> Gen.sorted2 + |> GenX.sorted2 x1 <=! x2 } @@ -50,9 +50,9 @@ let ``sorted2 generates a sorted 2-tuple`` () = let ``sorted3 generates a sorted 3-tuple`` () = Property.check <| property { let! x1, x2, x3 = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.tuple3 - |> Gen.sorted3 + |> GenX.sorted3 x1 <=! x2 x2 <=! x3 } @@ -61,9 +61,9 @@ let ``sorted3 generates a sorted 3-tuple`` () = let ``sorted4 generates a sorted 4-tuple`` () = Property.check <| property { let! x1, x2, x3, x4 = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.tuple4 - |> Gen.sorted4 + |> GenX.sorted4 x1 <=! x2 x2 <=! x3 x3 <=! x4 @@ -73,9 +73,9 @@ let ``sorted4 generates a sorted 4-tuple`` () = let ``distinct2 generates 2 non-equal elements`` () = Property.check <| property { let! x1, x2 = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.tuple - |> Gen.distinct2 + |> GenX.distinct2 [x1; x2] |> List.distinct =! [x1; x2] } @@ -83,9 +83,9 @@ let ``distinct2 generates 2 non-equal elements`` () = let ``distinct3 generates 3 non-equal elements`` () = Property.check <| property { let! x1, x2, x3 = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.tuple3 - |> Gen.distinct3 + |> GenX.distinct3 [x1; x2; x3] |> List.distinct =! [x1; x2; x3] } @@ -93,9 +93,9 @@ let ``distinct3 generates 3 non-equal elements`` () = let ``distinct4 generates 4 non-equal elements`` () = Property.check <| property { let! x1, x2, x3, x4 = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.tuple4 - |> Gen.distinct4 + |> GenX.distinct4 [x1; x2; x3; x4] |> List.distinct =! [x1; x2; x3; x4] } @@ -103,9 +103,9 @@ let ``distinct4 generates 4 non-equal elements`` () = let ``increasing2 generates a 2-tuple with strictly increasing elements`` () = Property.check <| property { let! x1, x2 = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.tuple - |> Gen.increasing2 + |> GenX.increasing2 x1 Gen.tuple3 - |> Gen.increasing3 + |> GenX.increasing3 x1 Gen.tuple4 - |> Gen.increasing4 + |> GenX.increasing4 x1 ] let ``dateInterval generates two dates spaced no more than the range allows`` () = Property.check <| property { - let! d1, d2 = Gen.dateInterval (Range.linear 0 100) + let! d1, d2 = GenX.dateInterval (Range.linear 0 100) (d2-d1).TotalDays <=! 100. } [] let ``dateInterval with positive interval generates increasing dates`` () = Property.check <| property { - let! d1, d2 = Gen.dateInterval (Range.linear 0 100) + let! d1, d2 = GenX.dateInterval (Range.linear 0 100) d2 >=! d1 } [] let ``dateInterval with negative interval generates increasing dates`` () = Property.check <| property { - let! d1, d2 = Gen.dateInterval (Range.linear 0 -100) + let! d1, d2 = GenX.dateInterval (Range.linear 0 -100) d2 <=! d1 } @@ -157,29 +157,29 @@ let ``dateInterval with negative interval generates increasing dates`` () = let ``withMapTo is defined for all elements in input list`` () = Property.check <| property { let! xs, f = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.list (Range.linear 1 50) - |> Gen.withMapTo (Gen.alphaNum) - xs |> List.map f |> ignore // should not throw + |> GenX.withMapTo Gen.alphaNum + xs |> List.map f |> ignore // Should not throw. } [] let ``withDistinctMapTo is defined for all elements in input list`` () = Property.check <| property { let! xs, f = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.list (Range.linear 1 50) - |> Gen.withDistinctMapTo (Gen.alphaNum) - xs |> List.map f |> ignore // should not throw + |> GenX.withDistinctMapTo Gen.alphaNum + xs |> List.map f |> ignore // Should not throw. } [] let ``withDistinctMapTo guarantees that distinct input values map to distinct output values`` () = Property.check <| property { let! xs, f = - Gen.int (Range.exponentialBounded()) + Gen.int (Range.exponentialBounded ()) |> Gen.list (Range.linear 1 50) - |> Gen.withDistinctMapTo (Gen.alphaNum) + |> GenX.withDistinctMapTo Gen.alphaNum let xsDistinct = xs |> List.distinct xsDistinct |> List.map f |> List.distinct |> List.length =! xsDistinct.Length -} \ No newline at end of file + }