Support Async<'Testable> & Task<'Testable> (#694)

Support async & task as first-class testables

Author: brianrourkeboll

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<int>) (x:int) = if (xs.Length > 2) && (x >10) then false else true
 Check.Quick prop_RevId'

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<Property> TaskProperty_ShouldPass(bool b)
+    {
+        await DoSomethingAsync();
+        return (b ^ !b).Label("b ^ !b");
+    }
+
+    [Property]
+    public async Task<Property> TaskProperty_ShouldFail(bool b)
+    {
+        await DoSomethingAsync();
+        return (b && !b).Label("b && !b");
+    }
+
+    private static async Task DoSomethingAsync() => await Task.Yield();
+}

examples/FsCheck.NUnit.Examples/FsCheck.NUnit.Examples.fsproj

@@ -9,6 +9,7 @@
     <ItemGroup>
         <Content Include="App.config" />
         <Compile Include="PropertyExamples.fs" />
+        <Compile Include="SyncVersusAsyncExamples.fs" />
     </ItemGroup>
     <ItemGroup>
         <PackageReference Include="Microsoft.NET.Test.Sdk" />

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 () }
+
+    [<Property>]
+    let ``Sync - should pass`` b =
+        b = b |> Prop.label "b = b"
+
+    [<Property>]
+    let ``Sync - should fail`` b =
+        b = not b |> Prop.label "b = not b"
+
+    [<Property>]
+    let ``Async - should pass`` b =
+        async {
+            do! doSomethingAsync ()
+            return b = b |> Prop.label "b = b"
+        }
+
+    [<Property>]
+    let ``Async - should fail`` b =
+        async {
+            do! doSomethingAsync ()
+            return b = not b |> Prop.label "b = not 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<Property> TaskProperty_ShouldPass(bool b)
+    {
+        await DoSomethingAsync();
+        return (b ^ !b).Label("b ^ !b");
+    }
+
+    [Property]
+    public async Task<Property> TaskProperty_ShouldFail(bool b)
+    {
+        await DoSomethingAsync();
+        return (b && !b).Label("b && !b");
+    }
+
+    private static async Task DoSomethingAsync() => await Task.Yield();
+}

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 known to a testable.
     [<CompiledName("OfTestable")>]
     let ofTestable (testable:'Testable) =
         property testable

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<Result>) -> f (x.Result, vr)) |> Future
-        | (Value vl,Future tr) -> tr.ContinueWith (fun (x :Task<Result>) -> f (x.Result, vl)) |> Future
+        | (Value vl,Future tr) -> tr.ContinueWith (fun (x :Task<Result>) -> f (vl, x.Result)) |> Future
         | (Future tl,Future tr) -> tl.ContinueWith (fun (x :Task<Result>) -> 
             tr.ContinueWith (fun (y :Task<Result>) -> 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<bool>) :Property = 
-            b.ContinueWith (fun (x:Task<bool>) -> 
-                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<ResultContainer> -> _) a = 
             fun arbMap -> 
                 property a 
@@ -194,21 +205,15 @@ module private Testable =
         static member Bool() =
             { new ITestable<bool> with
                 member __.Property b = Prop.ofBool b }
-        static member TaskBool() =
-            { new ITestable<Task<bool>> with
-                member __.Property b = Prop.ofTaskBool b }
         static member Task() =
             { new ITestable<Task> with
                 member __.Property b = Prop.ofTask b }
         static member TaskGeneric() =
             { new ITestable<Task<'T>> with
-                member __.Property b = Prop.ofTask (b :> Task) }
-        static member AsyncBool() =
-            { new ITestable<Async<bool>> with
-                member __.Property b = Prop.ofTaskBool <| Async.StartAsTask b }
-        static member Async() =
-            { new ITestable<Async<unit>> with
-                member __.Property b = Prop.ofTask <| Async.StartAsTask b }
+                member __.Property t = Prop.ofTaskGeneric t }
+        static member AsyncGeneric() =
+            { new ITestable<Async<'T>> with
+                member __.Property a = Prop.ofTaskGeneric <| Async.StartAsTask a }
         static member Lazy() =
             { new ITestable<Lazy<'T>> with
                 member __.Property b =

tests/FsCheck.Test/Arbitrary.fs

@@ -826,15 +826,117 @@ module Arbitrary =
         assert (ImmutableDictionary.CreateRange(values) |> shrink |> Seq.forall checkShrink)
         assert (ImmutableSortedDictionary.CreateRange(values) |> shrink |> Seq.forall checkShrink)
 
-    [<Property>]
-    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
-
     [<Fact>]
     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))
         let notShrinkable = Gen.choose(0, 10) |> Arb.fromGen
         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}'."
+
+        [<Fact>]
+        let ``()`` () = shouldBeTruthy "()" ()
+
+        [<Fact>]
+        let ``true`` () = shouldBeTruthy "true" true
+
+        [<Fact>]
+        let ``Prop.ofTestable ()`` () = shouldBeTruthy "Prop.ofTestable ()" (Prop.ofTestable ())
+
+        [<Fact>]
+        let ``lazy ()`` () = shouldBeTruthy "lazy ()" (lazy ())
+
+        [<Fact>]
+        let ``lazy true`` () = shouldBeTruthy "lazy true" (lazy true)
+
+        [<Fact>]
+        let ``lazy Prop.ofTestable ()`` () = shouldBeTruthy "lazy Prop.ofTestable ()" (lazy Prop.ofTestable ())
+
+        [<Fact>]
+        let ``gen { return () }`` () = shouldBeTruthy "gen { return () }" (gen { return () })
+
+        [<Fact>]
+        let ``gen { return true }`` () = shouldBeTruthy "gen { return true }" (gen { return true })
+
+        [<Fact>]
+        let ``gen { return Prop.ofTestable () }`` () = shouldBeTruthy "gen { return Prop.ofTestable () }" (gen { return Prop.ofTestable () })
+
+        [<Fact>]
+        let ``async { return () }`` () = shouldBeTruthy "async { return () }" (async { return () })
+
+        [<Fact>]
+        let ``async { return true }`` () = shouldBeTruthy "async { return true }" (async { return true })
+
+        [<Fact>]
+        let ``async { return Prop.ofTestable () }`` () = shouldBeTruthy "async { return Prop.ofTestable () }" (async { return Prop.ofTestable () })
+
+        [<Fact>]
+        let ``task { return true }`` () = shouldBeTruthy "task { return true }" (System.Threading.Tasks.Task.FromResult true)
+
+        [<Fact>]
+        let ``task { return () }`` () = shouldBeTruthy "task { return () }" (System.Threading.Tasks.Task.FromResult ())
+
+        [<Fact>]
+        let ``task { return Prop.ofTestable () }`` () = shouldBeTruthy "task { return Prop.ofTestable () }" (System.Threading.Tasks.Task.FromResult (Prop.ofTestable ()))
+
+        [<Fact>]
+        let ``task { return fun b -> b ==> b }`` () = shouldBeTruthy "task { return fun b -> b ==> b }" (System.Threading.Tasks.Task.FromResult (fun b -> b ==> b))
+
+        [<Fact>]
+        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}'."
+
+        [<Fact>]
+        let ``false`` () = shouldBeFalsy "false" false
+
+        [<Fact>]
+        let ``Prop.ofTestable false`` () = shouldBeFalsy "Prop.ofTestable false" (Prop.ofTestable false)
+
+        [<Fact>]
+        let ``lazy false`` () = shouldBeFalsy "lazy false" (lazy false)
+
+        [<Fact>]
+        let ``lazy Prop.ofTestable false`` () = shouldBeFalsy "lazy Prop.ofTestable false" (lazy Prop.ofTestable false)
+
+        [<Fact>]
+        let ``gen { return false }`` () = shouldBeFalsy "gen { return false }" (gen { return false })
+
+        [<Fact>]
+        let ``gen { return Prop.ofTestable false }`` () = shouldBeFalsy "gen { return Prop.ofTestable false }" (gen { return Prop.ofTestable false })
+
+        [<Fact>]
+        let ``async { return false }`` () = shouldBeFalsy "async { return false }" (async { return false })
+
+        [<Fact>]
+        let ``async { return Prop.ofTestable false }`` () = shouldBeFalsy "async { return Prop.ofTestable false }" (async { return Prop.ofTestable false })
+
+        [<Fact>]
+        let ``task { return false }`` () = shouldBeFalsy "task { return false }" (System.Threading.Tasks.Task.FromResult false)
+
+        [<Fact>]
+        let ``task { return Prop.ofTestable false }`` () = shouldBeFalsy "task { return Prop.ofTestable false }" (System.Threading.Tasks.Task.FromResult (Prop.ofTestable false))
+
+        [<Fact>]
+        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))
+
+        [<Fact>]
+        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)))
+
+        [<Fact>]
+        let ``task { return lazy false }`` () = shouldBeFalsy "task { return lazy false }" (System.Threading.Tasks.Task.FromResult (lazy false))