From d1e2e718f89c273dceaac6a14090c4d329817c51 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Mon, 20 Jan 2025 13:41:43 -0500 Subject: [PATCH 1/5] Support async & task as first-class testables --- .../SyncVersusAsyncExamples.cs | 56 +++++++++ .../FsCheck.NUnit.Examples.fsproj | 1 + .../SyncVersusAsyncExamples.fs | 29 +++++ .../SyncVersusAsyncExamples.cs | 57 +++++++++ src/FsCheck/FSharp.Prop.fs | 5 +- src/FsCheck/Testable.fs | 45 ++++---- tests/FsCheck.Test/Arbitrary.fs | 109 +++++++++++++++++- tests/FsCheck.Test/Property.fs | 61 +++++++--- 8 files changed, 316 insertions(+), 47 deletions(-) create mode 100644 examples/FsCheck.NUnit.CSharpExamples/SyncVersusAsyncExamples.cs create mode 100644 examples/FsCheck.NUnit.Examples/SyncVersusAsyncExamples.fs create mode 100644 examples/FsCheck.XUnit.CSharpExamples/SyncVersusAsyncExamples.cs diff --git a/examples/FsCheck.NUnit.CSharpExamples/SyncVersusAsyncExamples.cs b/examples/FsCheck.NUnit.CSharpExamples/SyncVersusAsyncExamples.cs new file mode 100644 index 00000000..42107163 --- /dev/null +++ b/examples/FsCheck.NUnit.CSharpExamples/SyncVersusAsyncExamples.cs @@ -0,0 +1,56 @@ +using System.Threading.Tasks; +using FsCheck.Fluent; +using NUnit.Framework; + +namespace FsCheck.NUnit.CSharpExamples; + +public class SyncVersusAsyncExamples +{ + [Property] + public Property Property_ShouldPass(bool b) + { + return (b ^ !b).Label("b ^ !b"); + } + + [Property] + public Property Property_ShouldFail(bool b) + { + return (b && !b).Label("b && !b"); + } + + [Property] + public async Task Task_ShouldPass(bool b) + { + await DoSomethingAsync(); + Assert.That(b ^ !b); + } + + [Property] + public async Task Task_Exception_ShouldFail(bool b) + { + await DoSomethingAsync(); + Assert.That(b && !b); + } + + [Property] + public async Task Task_Cancelled_ShouldFail(bool b) + { + await Task.Run(() => Assert.That(b ^ !b), new System.Threading.CancellationToken(canceled: true)); + } + + [Property] + public async Task TaskProperty_ShouldPass(bool b) + { + await DoSomethingAsync(); + return (b ^ !b).Label("b ^ !b"); + } + + [Property] + public async Task TaskProperty_ShouldFail(bool b) + { + await DoSomethingAsync(); + return (b && !b).Label("b && !b"); + } + + private static async Task DoSomethingAsync() => await Task.Yield(); +} diff --git a/examples/FsCheck.NUnit.Examples/FsCheck.NUnit.Examples.fsproj b/examples/FsCheck.NUnit.Examples/FsCheck.NUnit.Examples.fsproj index 6803d52a..323c7dd2 100644 --- a/examples/FsCheck.NUnit.Examples/FsCheck.NUnit.Examples.fsproj +++ b/examples/FsCheck.NUnit.Examples/FsCheck.NUnit.Examples.fsproj @@ -9,6 +9,7 @@ + diff --git a/examples/FsCheck.NUnit.Examples/SyncVersusAsyncExamples.fs b/examples/FsCheck.NUnit.Examples/SyncVersusAsyncExamples.fs new file mode 100644 index 00000000..e3b519ef --- /dev/null +++ b/examples/FsCheck.NUnit.Examples/SyncVersusAsyncExamples.fs @@ -0,0 +1,29 @@ +namespace FsCheck.NUnit.Examples + +open FsCheck.FSharp +open FsCheck.NUnit + +module SyncVersusAsyncExamples = + let private doSomethingAsync () = async { return () } + + [] + let ``Sync - should pass`` b = + b = b |> Prop.label "b = b" + + [] + let ``Sync - should fail`` b = + b = not b |> Prop.label "b = not b" + + [] + let ``Async - should pass`` b = + async { + do! doSomethingAsync () + return b = b |> Prop.label "b = b" + } + + [] + let ``Async - should fail`` b = + async { + do! doSomethingAsync () + return b = not b |> Prop.label "b = not b" + } diff --git a/examples/FsCheck.XUnit.CSharpExamples/SyncVersusAsyncExamples.cs b/examples/FsCheck.XUnit.CSharpExamples/SyncVersusAsyncExamples.cs new file mode 100644 index 00000000..294ad104 --- /dev/null +++ b/examples/FsCheck.XUnit.CSharpExamples/SyncVersusAsyncExamples.cs @@ -0,0 +1,57 @@ +using System.Threading.Tasks; +using FsCheck.Fluent; +using FsCheck.Xunit; +using Xunit; + +namespace FsCheck.XUnit.CSharpExamples; + +public class SyncVersusAsyncExamples +{ + [Property] + public Property Property_ShouldPass(bool b) + { + return (b ^ !b).Label("b ^ !b"); + } + + [Property] + public Property Property_ShouldFail(bool b) + { + return (b && !b).Label("b && !b"); + } + + [Property] + public async Task Task_ShouldPass(bool b) + { + await DoSomethingAsync(); + Assert.True(b ^ !b); + } + + [Property] + public async Task Task_Exception_ShouldFail(bool b) + { + await DoSomethingAsync(); + Assert.True(b && !b); + } + + [Property] + public async Task Task_Cancelled_ShouldFail(bool b) + { + await Task.Run(() => Assert.True(b ^ !b), new System.Threading.CancellationToken(canceled: true)); + } + + [Property] + public async Task TaskProperty_ShouldPass(bool b) + { + await DoSomethingAsync(); + return (b ^ !b).Label("b ^ !b"); + } + + [Property] + public async Task TaskProperty_ShouldFail(bool b) + { + await DoSomethingAsync(); + return (b && !b).Label("b && !b"); + } + + private static async Task DoSomethingAsync() => await Task.Yield(); +} diff --git a/src/FsCheck/FSharp.Prop.fs b/src/FsCheck/FSharp.Prop.fs index 328850a7..7ed00e6c 100644 --- a/src/FsCheck/FSharp.Prop.fs +++ b/src/FsCheck/FSharp.Prop.fs @@ -67,9 +67,8 @@ module Prop = { r with Labels = Set.add l r.Labels }) |> Future Prop.mapResult add - /// Turns a testable type into a property. Testables are unit, boolean, Lazy testables, Gen testables, functions - /// from a type for which a generator is know to a testable, tuples up to 6 tuple containing testables, and lists - /// containing testables. + /// Turns a testable type into a property. Testables are unit, boolean, Lazy testables, Gen testables, + /// Async testables, Task testables, and functions from a type for which a generator is know to a testable. [] let ofTestable (testable:'Testable) = property testable diff --git a/src/FsCheck/Testable.fs b/src/FsCheck/Testable.fs index 9418e9e7..523a987c 100644 --- a/src/FsCheck/Testable.fs +++ b/src/FsCheck/Testable.fs @@ -46,7 +46,7 @@ type ResultContainer = match (l,r) with | (Value vl,Value vr) -> f (vl, vr) |> Value | (Future tl,Value vr) -> tl.ContinueWith (fun (x :Task) -> f (x.Result, vr)) |> Future - | (Value vl,Future tr) -> tr.ContinueWith (fun (x :Task) -> f (x.Result, vl)) |> Future + | (Value vl,Future tr) -> tr.ContinueWith (fun (x :Task) -> f (vl, x.Result)) |> Future | (Future tl,Future tr) -> tl.ContinueWith (fun (x :Task) -> tr.ContinueWith (fun (y :Task) -> f (x.Result, y.Result))) |> TaskExtensions.Unwrap |> Future static member (&&&) (l,r) = ResultContainer.MapResult2(Result.ResAnd, l, r) @@ -113,15 +113,6 @@ module private Testable = |> Value |> ofResult - let ofTaskBool (b:Task) :Property = - b.ContinueWith (fun (x:Task) -> - match (x.IsCanceled, x.IsFaulted) with - | (false,false) -> Res.ofBool x.Result - | (_,true) -> Res.failedException x.Exception - | (true,_) -> Res.failedCancelled) - |> Future - |> ofResult - let ofTask (b:Task) :Property = b.ContinueWith (fun (x:Task) -> match (x.IsCanceled, x.IsFaulted) with @@ -131,6 +122,26 @@ module private Testable = |> Future |> ofResult + let ofTaskGeneric (t : Task<'T>) : Property = + Property (fun arbMap -> + Gen.promote (fun runner -> + Shrink.ofValue (Future ( + t.ContinueWith (fun (t : Task<'T>) -> + match t.IsCanceled, t.IsFaulted with + | _, true -> Task.FromResult (Res.failedException t.Exception) + | true, _ -> Task.FromResult Res.failedCancelled + | false, false -> + let prop = property t.Result + let gen = Property.GetGen arbMap prop + let shrink = runner gen + + let value, shrinks = Shrink.getValue shrink + assert Seq.isEmpty shrinks + match value with + | Value result -> Task.FromResult result + | Future resultTask -> resultTask) + |> _.Unwrap())))) + let mapShrinkResult (f:Shrink -> _) a = fun arbMap -> property a @@ -194,21 +205,15 @@ module private Testable = static member Bool() = { new ITestable with member __.Property b = Prop.ofBool b } - static member TaskBool() = - { new ITestable> with - member __.Property b = Prop.ofTaskBool b } static member Task() = { new ITestable with member __.Property b = Prop.ofTask b } static member TaskGeneric() = { new ITestable> with - member __.Property b = Prop.ofTask (b :> Task) } - static member AsyncBool() = - { new ITestable> with - member __.Property b = Prop.ofTaskBool <| Async.StartAsTask b } - static member Async() = - { new ITestable> with - member __.Property b = Prop.ofTask <| Async.StartAsTask b } + member __.Property t = Prop.ofTaskGeneric t } + static member AsyncGeneric() = + { new ITestable> with + member __.Property a = Prop.ofTaskGeneric <| Async.StartAsTask a } static member Lazy() = { new ITestable> with member __.Property b = diff --git a/tests/FsCheck.Test/Arbitrary.fs b/tests/FsCheck.Test/Arbitrary.fs index bc641aaf..fd282682 100644 --- a/tests/FsCheck.Test/Arbitrary.fs +++ b/tests/FsCheck.Test/Arbitrary.fs @@ -826,11 +826,6 @@ module Arbitrary = assert (ImmutableDictionary.CreateRange(values) |> shrink |> Seq.forall checkShrink) assert (ImmutableSortedDictionary.CreateRange(values) |> shrink |> Seq.forall checkShrink) - [] - let ``should execute generic-task-valued property`` (value: int) = - // Since this doesn't throw, the test should pass and ignore the integer value - System.Threading.Tasks.Task.FromResult value - [] let ``Zip should shrink both values independently``() = let shrinkable = Arb.fromGenShrink(Gen.choose(0, 10), fun x -> [| x-1 |] |> Seq.where(fun x -> x >= 0)) @@ -838,3 +833,107 @@ module Arbitrary = let zipped = Fluent.Arb.Zip(shrinkable, notShrinkable) let shrinks = zipped.Shrinker(struct (10, 10)) |> Seq.toArray test <@ shrinks = [| struct (9, 10) |] @> + + module Truthy = + let private shouldBeTruthy description testable = + try Check.One (Config.QuickThrowOnFailure, testable) with + | exn -> failwith $"'%s{description}' should be truthy. Got: '{exn}'." + + [] + let ``()`` () = shouldBeTruthy "()" () + + [] + let ``true`` () = shouldBeTruthy "true" true + + [] + let ``Prop.ofTestable ()`` () = shouldBeTruthy "Prop.ofTestable ()" (Prop.ofTestable ()) + + [] + let ``lazy ()`` () = shouldBeTruthy "lazy ()" (lazy ()) + + [] + let ``lazy true`` () = shouldBeTruthy "lazy true" (lazy true) + + [] + let ``lazy Prop.ofTestable ()`` () = shouldBeTruthy "lazy Prop.ofTestable ()" (lazy Prop.ofTestable ()) + + [] + let ``gen { return () }`` () = shouldBeTruthy "gen { return () }" (gen { return () }) + + [] + let ``gen { return true }`` () = shouldBeTruthy "gen { return true }" (gen { return true }) + + [] + let ``gen { return Prop.ofTestable () }`` () = shouldBeTruthy "gen { return Prop.ofTestable () }" (gen { return Prop.ofTestable () }) + + [] + let ``async { return () }`` () = shouldBeTruthy "async { return () }" (async { return () }) + + [] + let ``async { return true }`` () = shouldBeTruthy "async { return true }" (async { return true }) + + [] + let ``async { return Prop.ofTestable () }`` () = shouldBeTruthy "async { return Prop.ofTestable () }" (async { return Prop.ofTestable () }) + + [] + let ``task { return true }`` () = shouldBeTruthy "task { return true }" (System.Threading.Tasks.Task.FromResult true) + + [] + let ``task { return () }`` () = shouldBeTruthy "task { return () }" (System.Threading.Tasks.Task.FromResult ()) + + [] + let ``task { return Prop.ofTestable () }`` () = shouldBeTruthy "task { return Prop.ofTestable () }" (System.Threading.Tasks.Task.FromResult (Prop.ofTestable ())) + + [] + let ``task { return fun b -> b ==> b }`` () = shouldBeTruthy "task { return fun b -> b ==> b }" (System.Threading.Tasks.Task.FromResult (fun b -> b ==> b)) + + [] + let ``task { return task { return true } }`` () = shouldBeTruthy "task { return task { return true } }" (System.Threading.Tasks.Task.FromResult (Prop.ofTestable (System.Threading.Tasks.Task.FromResult true))) + + module Falsy = + let private shouldBeFalsy description testable = + let exn = + try Check.One (Config.QuickThrowOnFailure, testable); None with + | exn -> Some exn + + match exn with + | None -> failwith $"'%s{description}' should be falsy." + | Some exn -> + if not (exn.Message.StartsWith "Falsifiable") then + failwith $"Unexpected exception: '{exn}'." + + [] + let ``false`` () = shouldBeFalsy "false" false + + [] + let ``Prop.ofTestable false`` () = shouldBeFalsy "Prop.ofTestable false" (Prop.ofTestable false) + + [] + let ``lazy false`` () = shouldBeFalsy "lazy false" (lazy false) + + [] + let ``lazy Prop.ofTestable false`` () = shouldBeFalsy "lazy Prop.ofTestable false" (lazy Prop.ofTestable false) + + [] + let ``gen { return false }`` () = shouldBeFalsy "gen { return false }" (gen { return false }) + + [] + let ``gen { return Prop.ofTestable false }`` () = shouldBeFalsy "gen { return Prop.ofTestable false }" (gen { return Prop.ofTestable false }) + + [] + let ``async { return false }`` () = shouldBeFalsy "async { return false }" (async { return false }) + + [] + let ``async { return Prop.ofTestable false }`` () = shouldBeFalsy "async { return Prop.ofTestable false }" (async { return Prop.ofTestable false }) + + [] + let ``task { return false }`` () = shouldBeFalsy "task { return false }" (System.Threading.Tasks.Task.FromResult false) + + [] + let ``task { return Prop.ofTestable false }`` () = shouldBeFalsy "task { return Prop.ofTestable false }" (System.Threading.Tasks.Task.FromResult (Prop.ofTestable false)) + + [] + let ``task { return fun b -> b ==> not b }`` () = shouldBeFalsy "task { return fun b -> b ==> not b }" (System.Threading.Tasks.Task.FromResult (fun b -> b ==> not b)) + + [] + let ``task { return task { return false } }`` () = shouldBeFalsy "task { return task { return false } }" (System.Threading.Tasks.Task.FromResult (Prop.ofTestable (System.Threading.Tasks.Task.FromResult false))) diff --git a/tests/FsCheck.Test/Property.fs b/tests/FsCheck.Test/Property.fs index 862cd832..1fe016aa 100644 --- a/tests/FsCheck.Test/Property.fs +++ b/tests/FsCheck.Test/Property.fs @@ -8,6 +8,7 @@ module Property = open FsCheck.FSharp open FsCheck.Xunit open System + open System.Threading open System.Threading.Tasks open Swensen.Unquote @@ -26,9 +27,13 @@ module Property = | And of SymProp * SymProp | Or of SymProp * SymProp | LazyProp of SymProp - | Tuple2 of SymProp * SymProp - | Tuple3 of SymProp * SymProp * SymProp //and 4,5,6 - | List of SymProp list + | Task + | FaultedTask + | CancelledTask + | TaskProp of SymProp + | FaultedTaskProp of SymProp + | CancelledTaskProp of SymProp + | AsyncProp of SymProp let rec private symPropGen = let rec recGen size = @@ -45,9 +50,13 @@ module Property = ; Gen.map2 (curry And) (subProp) (subProp) ; Gen.map2 (curry Or) (subProp) (subProp) ; Gen.map LazyProp subProp - ; Gen.map2 (curry Tuple2) subProp subProp - ; Gen.map3 (curry2 Tuple3) subProp subProp subProp - ; Gen.map List (Gen.resize 3 <| Gen.nonEmptyListOf subProp) + ; Gen.constant Task + ; Gen.constant FaultedTask + ; Gen.constant CancelledTask + ; Gen.map TaskProp subProp + ; Gen.map FaultedTaskProp subProp + ; Gen.map CancelledTaskProp subProp + ; Gen.map AsyncProp subProp ] | _ -> failwith "symPropGen: size must be positive" Gen.sized recGen @@ -67,7 +76,7 @@ module Property = | Unit -> { result with Outcome= Outcome.Passed } | Bool true -> { result with Outcome= Outcome.Passed } | Bool false -> { result with Outcome= Outcome.Failed (exn "")} - | Exception -> { result with Outcome= Outcome.Failed (InvalidOperationException() :> exn)} + | Exception | FaultedTask | FaultedTaskProp _ -> { result with Outcome= Outcome.Failed (InvalidOperationException() :> exn)} | ForAll (i,prop) -> determineResult prop |> addArgument i | Implies (true,prop) -> determineResult prop | Implies (false,_) -> { result with Outcome= Outcome.Rejected } @@ -78,9 +87,9 @@ module Property = | And (prop1, prop2) -> andCombine prop1 prop2 | Or (prop1, prop2) -> let r1,r2 = determineResult prop1, determineResult prop2 in Result.ResOr(r1, r2) | LazyProp prop -> determineResult prop - | Tuple2 (prop1,prop2) -> andCombine prop1 prop2 - | Tuple3 (prop1,prop2,prop3) -> Result.ResAnd (andCombine prop1 prop2, determineResult prop3) - | List props -> List.fold (fun st p -> Result.ResAnd (st, determineResult p)) (List.head props |> determineResult) (List.tail props) + | Task -> { result with Outcome = Outcome.Passed } + | CancelledTask | CancelledTaskProp _ -> { result with Outcome = Outcome.Failed (exn "The Task was canceled.") } + | TaskProp prop | AsyncProp prop -> determineResult prop let rec private toProperty prop = match prop with @@ -94,10 +103,26 @@ module Property = | Label (l,prop) -> Prop.label l (toProperty prop) | And (prop1,prop2) -> (toProperty prop1) .&. (toProperty prop2) | Or (prop1,prop2) -> (toProperty prop1) .|. (toProperty prop2) - | LazyProp prop -> toProperty prop - | Tuple2 (prop1,prop2) -> (toProperty prop1) .&. (toProperty prop2) - | Tuple3 (prop1,prop2,prop3) -> (toProperty prop1) .&. (toProperty prop2) .&. (toProperty prop3) - | List props -> List.fold (fun st p -> st .&. toProperty p) (List.head props |> toProperty) (List.tail props) + | LazyProp prop -> Prop.ofTestable (lazy toProperty prop) + | Task -> Prop.ofTestable Task.CompletedTask + | FaultedTask -> Prop.ofTestable (Task.FromException (InvalidOperationException ())) + | CancelledTask -> Prop.ofTestable (Task.FromCanceled (CancellationToken (canceled=true))) + | FaultedTaskProp Unit -> Prop.ofTestable (Task.FromException (InvalidOperationException ())) + | FaultedTaskProp (Bool _) -> Prop.ofTestable (Task.FromException (InvalidOperationException ())) + | FaultedTaskProp (LazyProp (Bool _)) -> Prop.ofTestable (Task.FromException> (InvalidOperationException ())) + | FaultedTaskProp _ -> Prop.ofTestable (Task.FromException (InvalidOperationException ())) + | CancelledTaskProp Unit -> Prop.ofTestable (Task.FromCanceled (CancellationToken (canceled=true))) + | CancelledTaskProp (Bool _) -> Prop.ofTestable (Task.FromCanceled (CancellationToken (canceled=true))) + | CancelledTaskProp (LazyProp (Bool _)) -> Prop.ofTestable (Task.FromCanceled> (CancellationToken (canceled=true))) + | CancelledTaskProp _ -> Prop.ofTestable (Task.FromCanceled (CancellationToken (canceled=true))) + | TaskProp Unit -> Prop.ofTestable (Task.FromResult ()) + | TaskProp (Bool b) -> Prop.ofTestable (Task.FromResult b) + | TaskProp (LazyProp prop) -> Prop.ofTestable (Task.FromResult (lazy toProperty prop)) + | TaskProp prop -> Prop.ofTestable (Task.FromResult (toProperty prop)) + | AsyncProp Unit -> Prop.ofTestable (async { return () }) + | AsyncProp (Bool b) -> Prop.ofTestable (async { return b }) + | AsyncProp (LazyProp prop) -> Prop.ofTestable (async { return lazy toProperty prop }) + | AsyncProp prop -> Prop.ofTestable (async { return toProperty prop }) let private areSame (r0:Result) (r1:TestResult) = let testData = @@ -125,9 +150,8 @@ module Property = | And (prop1,prop2) -> 1 + Math.Max(depth prop1, depth prop2) | Or (prop1,prop2) -> 1 + Math.Max(depth prop1, depth prop2) | LazyProp prop -> 1 + (depth prop) - | Tuple2 (prop1,prop2) -> 1 + Math.Max(depth prop1, depth prop2) - | Tuple3 (prop1,prop2,prop3) -> 1 + Math.Max(Math.Max(depth prop1, depth prop2),depth prop3) - | List props -> 1 + List.fold (fun a b -> Math.Max(a, depth b)) 0 props + | Task | FaultedTask | CancelledTask -> 0 + | TaskProp prop | AsyncProp prop | FaultedTaskProp prop | CancelledTaskProp prop -> 1 + depth prop //can not be an anonymous type because of let mutable. type private GetResultRunner() = @@ -152,13 +176,12 @@ module Property = let DSL() = Prop.forAll (Arb.fromGen symPropGen) (fun symprop -> let expected = determineResult symprop - let actual = checkResult (toProperty symprop) let resultRunner = GetResultRunner() let config = Config.Quick.WithRunner(resultRunner).WithMaxTest(2) Check.One(config,toProperty symprop) let actual = resultRunner.Result areSame expected actual - |> Prop.label (sprintf "expected = %A - actual = %A" expected actual) + |> Prop.label (sprintf "\nexpected =\n%A\nactual =\n%A" expected actual) |> Prop.collect (depth symprop) ) From ecd7e8fe79f4e66d241f574ccdf92dd467abe24e Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Mon, 20 Jan 2025 13:42:45 -0500 Subject: [PATCH 2/5] Fix example --- examples/FsCheck.Examples/Examples.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/FsCheck.Examples/Examples.fs b/examples/FsCheck.Examples/Examples.fs index f4df9bf2..78dcf822 100644 --- a/examples/FsCheck.Examples/Examples.fs +++ b/examples/FsCheck.Examples/Examples.fs @@ -194,7 +194,7 @@ Check.One(bigSize,fun (s:Simple) -> match s with Leaf2 _ -> false | Void3 -> fal Check.One(bigSize,fun i -> (-10 < i && i < 0) || (0 < i) && (i < 10 )) Check.Quick (fun opt -> match opt with None -> false | Some b -> b ) -Check.Quick (fun opt -> match opt with Some n when n<0 -> false | Some n when n >= 0 -> true | _ -> true ) +Check.Quick (fun opt -> match opt with Some n when n < 0 -> false | Some n when n >= 0 -> true | _ -> true ) let prop_RevId' (xs:list) (x:int) = if (xs.Length > 2) && (x >10) then false else true Check.Quick prop_RevId' From 9dd91fd7fc37b356bfbc64f4b263dd82b92f54f0 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Mon, 20 Jan 2025 14:34:47 -0500 Subject: [PATCH 3/5] Add some more sanity check tests --- tests/FsCheck.Test/Property.fs | 50 ++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/tests/FsCheck.Test/Property.fs b/tests/FsCheck.Test/Property.fs index 1fe016aa..ed1858f1 100644 --- a/tests/FsCheck.Test/Property.fs +++ b/tests/FsCheck.Test/Property.fs @@ -152,6 +152,14 @@ module Property = | LazyProp prop -> 1 + (depth prop) | Task | FaultedTask | CancelledTask -> 0 | TaskProp prop | AsyncProp prop | FaultedTaskProp prop | CancelledTaskProp prop -> 1 + depth prop + + module private TestResult = + let areSame result1 result2 = + match result1, result2 with + | TestResult.Failed ({ Labels = labels1 },_,_,Outcome.Failed _,_,_,_), TestResult.Failed ({ Labels = labels2 },_,_,Outcome.Failed _,_,_,_) -> labels1 = labels2 + | TestResult.Passed ({ Stamps = stamps1 },_), TestResult.Passed ({ Stamps = stamps2 },_) -> (stamps1 |> Seq.collect snd |> Set.ofSeq) = (stamps2 |> Seq.collect snd |> Set.ofSeq) + | TestResult.Exhausted _, TestResult.Exhausted _ -> true + | _ -> false //can not be an anonymous type because of let mutable. type private GetResultRunner() = @@ -185,6 +193,48 @@ module Property = |> Prop.collect (depth symprop) ) + [] + let ``Synchronous unit properties behave the same as asynchronous ones`` () = + ( + checkResult (Prop.ofTestable ()), + checkResult (Prop.ofTestable (async { return () })) + ) ||> TestResult.areSame + + [] + let ``Synchronous unit properties behave the same as task-asynchronous ones`` () = + ( + checkResult (Prop.ofTestable ()), + checkResult (Prop.ofTestable (Task.FromResult ())) + ) ||> TestResult.areSame + + [] + let ``Synchronous Boolean properties behave the same as asynchronous ones`` (b : bool) = + ( + checkResult (Prop.ofTestable b), + checkResult (Prop.ofTestable (async { return b })) + ) ||> TestResult.areSame + + [] + let ``Synchronous Boolean properties behave the same as task-asynchronous ones`` (b : bool) = + ( + checkResult (Prop.ofTestable b), + checkResult (Prop.ofTestable (Task.FromResult b)) + ) ||> TestResult.areSame + + [] + let ``Synchronous properties behave the same as asynchronous ones`` (b : bool) = + ( + checkResult (b |> Prop.label $"{b}"), + checkResult (Prop.ofTestable (async { return b |> Prop.label $"{b}" })) + ) ||> TestResult.areSame + + [] + let ``Synchronous properties behave the same as task-asynchronous ones`` (b : bool) = + ( + checkResult (b |> Prop.label $"{b}"), + checkResult (Prop.ofTestable (Task.FromResult (b |> Prop.label $"{b}"))) + ) ||> TestResult.areSame + [] let ``Or of exception and success should be success``() = let a = Prop.ofTestable <| lazy failwith "crash" From b49181096df2dd710b10ab6be7066d2ecd951646 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Mon, 20 Jan 2025 15:06:14 -0500 Subject: [PATCH 4/5] Fix up comment some more --- src/FsCheck/FSharp.Prop.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/FsCheck/FSharp.Prop.fs b/src/FsCheck/FSharp.Prop.fs index 7ed00e6c..7d60b54b 100644 --- a/src/FsCheck/FSharp.Prop.fs +++ b/src/FsCheck/FSharp.Prop.fs @@ -67,8 +67,8 @@ module Prop = { r with Labels = Set.add l r.Labels }) |> Future Prop.mapResult add - /// Turns a testable type into a property. Testables are unit, boolean, Lazy testables, Gen testables, - /// Async testables, Task testables, and functions from a type for which a generator is know to a testable. + /// Turns a testable type into a property. Testables are unit, Boolean, Lazy testables, Gen testables, + /// Async testables, Task testables, and functions from a type for which a generator is known to a testable. [] let ofTestable (testable:'Testable) = property testable From 441f565d320b51a503e8a3fbdd603b33386a34d7 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Mon, 20 Jan 2025 15:06:20 -0500 Subject: [PATCH 5/5] One more --- tests/FsCheck.Test/Arbitrary.fs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/FsCheck.Test/Arbitrary.fs b/tests/FsCheck.Test/Arbitrary.fs index fd282682..79620dd7 100644 --- a/tests/FsCheck.Test/Arbitrary.fs +++ b/tests/FsCheck.Test/Arbitrary.fs @@ -937,3 +937,6 @@ module Arbitrary = [] let ``task { return task { return false } }`` () = shouldBeFalsy "task { return task { return false } }" (System.Threading.Tasks.Task.FromResult (Prop.ofTestable (System.Threading.Tasks.Task.FromResult false))) + + [] + let ``task { return lazy false }`` () = shouldBeFalsy "task { return lazy false }" (System.Threading.Tasks.Task.FromResult (lazy false))