Migrate to FsCheck3 in a separate project

Expecto.FsCheck3/Expecto.FsCheck3.fsproj

@@ -0,0 +1,16 @@
+<Project Sdk="Microsoft.NET.Sdk">
+  <PropertyGroup>
+    <PackageId>Expecto.FsCheck3</PackageId>
+    <Description>Property testing for Expecto, powered by FsCheck3</Description>
+    <TargetFramework>net6.0</TargetFramework>
+  </PropertyGroup>
+  <ItemGroup>
+    <Compile Include="FsCheck3.fs" />
+    <None Include="paket.references" />
+  </ItemGroup>
+  <ItemGroup>
+    <ProjectReference Include="..\Expecto\Expecto.fsproj" />
+  </ItemGroup>
+  <Import Project="..\NuGet.props" />
+  <Import Project="..\.paket\Paket.Restore.targets" />
+</Project>

Expecto.FsCheck3/FsCheck3.fs

@@ -0,0 +1,196 @@
+namespace Expecto
+
+open System
+open FsCheck
+open Expecto
+
+[<AutoOpen; CompilationRepresentationAttribute(CompilationRepresentationFlags.ModuleSuffix)>]
+module ExpectoFsCheck =
+
+  let private propertyTest methodName focusState configs name property =
+
+    /// This running plugs into FsCheck and gives us the ability to get called
+    /// by the framework on start/finish of fixtures.
+    let runner (config: FsCheckConfig) =
+      { new IRunner with
+          /// Called before a group of properties on a type are checked.
+          member __.OnStartFixture _ =
+            ()
+
+          /// Called whenever arguments are generated and after the test is run.
+          member __.OnArguments (testNumber, args, formatOnEvery) =
+            config.receivedArgs config name testNumber args
+            |> Async.RunSynchronously
+
+          /// Called on a succesful shrink.
+          member __.OnShrink (values, formatValues) =
+            config.successfulShrink config name values
+            |> Async.RunSynchronously
+
+          /// Called whenever all tests are done, either True, False or Exhausted.
+          member __.OnFinished (fsCheckTestName, testResult) =
+            config.finishedTest config fsCheckTestName
+            |> Async.RunSynchronously
+
+            let numTests i = if i = 1 then "1 test" else sprintf "%i tests" i
+
+            let stampsToString s =
+              let entry (p,xs) = sprintf "%A%s %s" p "%" (String.concat ", " xs)
+              match Seq.map entry s |> Seq.toList with
+              | []  -> ""
+              | [x] -> sprintf " (%s)\n" x
+              | xs  -> sprintf "%s\n" (String.concat "\n" xs)
+
+            match testResult with
+            | TestResult.Passed (_testData,_b) -> ()
+
+            | TestResult.Failed (_,_,_, Outcome.Failed (:? IgnoreException as e),_,_,_) ->
+              raise e
+
+            | TestResult.Failed (data, original, shrunk, outcome,originalSeed,_finalSeed,size) ->
+              let parameters =
+                original
+                |> List.map (sprintf "%A")
+                |> String.concat " "
+                |> sprintf "Parameters:\n\t%s"
+
+              let shrunk =
+                if data.NumberOfShrinks > 0 then
+                  shrunk
+                  |> List.map (sprintf "%A")
+                  |> String.concat " "
+                  |> sprintf "\nShrunk %i times to:\n\t%s" data.NumberOfShrinks
+                else ""
+
+              let labels =
+                match data.Labels.Count with
+                | 0 -> String.Empty
+                | 1 -> sprintf "Label of failing property: %s\n"
+                          (Set.toSeq data.Labels |> Seq.head)
+                | _ -> sprintf "Labels of failing property (one or more is failing): %s\n"
+                          (String.concat " " data.Labels)
+
+              let focus =
+                sprintf "Focus on error:\n\t%s (%i, %i) \"%s\"" methodName originalSeed.Seed originalSeed.Gamma name
+
+              sprintf "Failed after %s. %s%s\nResult:\n\t%A\n%s%s%s"
+                      (numTests data.NumberOfTests) parameters shrunk
+                      outcome labels (stampsToString data.Stamps) focus
+              |> FailedException
+              |> raise
+
+            | TestResult.Exhausted data ->
+              sprintf "Exhausted after %s%s"
+                (numTests data.NumberOfTests) (stampsToString data.Stamps)
+              |> FailedException
+              |> raise
+      }
+
+    let test (config: FsCheckConfig) =
+
+      let config =
+        Config.Default
+            .WithMaxTest(config.maxTest)
+            .WithReplay(Option.map (fun (seed,gamma) -> {Rnd = Rnd(uint64 seed, uint64 gamma); Size = None}) config.replay)
+            .WithName(name)
+            .WithStartSize(config.startSize)
+            .WithEndSize(config.endSize)
+            .WithQuietOnSuccess(true)
+            .WithArbitrary(config.arbitrary)
+            .WithRunner(runner config)
+
+
+      Check.One(config, property)
+      |> async.Return
+
+    let testCode =
+      match configs with
+      | None ->
+        AsyncFsCheck (None, None, test)
+      | Some (testConfig, stressConfig) ->
+        AsyncFsCheck (Some testConfig, Some stressConfig, test)
+
+    TestLabel(name, TestCase (testCode, focusState), focusState)
+
+  /// Builds a test property with config
+  let testPropertyWithConfigs testConfig stressConfig name =
+    propertyTest "etestPropertyWithConfigs" Normal
+                 (Some(testConfig, stressConfig)) name
+
+  /// Builds an ignored test property with an explicit config.
+  let ptestPropertyWithConfigs testConfig stressConfig name =
+    propertyTest "etestPropertyWithConfigs" Pending
+                 (Some (testConfig,stressConfig)) name
+
+  /// Builds an ignored test property with an explicit config.
+  let ftestPropertyWithConfigs testConfig stressConfig name =
+    propertyTest "etestPropertyWithConfigs" Focused
+                 (Some (testConfig,stressConfig)) name
+
+  /// Builds a test property with config that will make Expecto to
+  /// ignore other unfocused tests and use an error stdGen.
+  let etestPropertyWithConfigs stdGen testConfig stressConfig name =
+    let testConfig = { testConfig with replay = Some stdGen }
+    let stressConfig = { stressConfig with replay = Some stdGen }
+    propertyTest "etestPropertyWithConfigs" Focused
+                 (Some(testConfig,stressConfig)) name
+
+  let testPropertyWithConfigsStdGen stdGen testConfig stressConfig name =
+    let testConfig = { testConfig with replay = Some stdGen }
+    let stressConfig = { stressConfig with replay = Some stdGen }
+    propertyTest "testPropertyWithConfigsStdGen" Normal (Some (testConfig,stressConfig)) name
+
+  /// Builds a test property with config
+  let testPropertyWithConfig config name =
+    propertyTest "etestPropertyWithConfig" Normal (Some (config,config)) name
+
+  /// Builds a test property with config that will be ignored by Expecto.
+  let ptestPropertyWithConfig config name =
+    propertyTest "etestPropertyWithConfig" Pending (Some(config,config)) name
+
+  /// Builds a test property with config that will make Expecto
+  /// ignore other unfocused tests
+  let ftestPropertyWithConfig config name =
+    propertyTest "etestPropertyWithConfig" Focused (Some(config,config)) name
+
+  /// Builds a test property with config that will make Expecto
+  /// ignore other unfocused tests and use an error stdGen.
+  let etestPropertyWithConfig stdGen config name =
+    let config = { config with replay = Some stdGen }
+    propertyTest "etestPropertyWithConfig" Focused (Some(config,config)) name
+
+  /// Builds a test property with a config and a random seed number to ensure FsCheck runs identically every time.
+  let testPropertyWithConfigStdGen stdGen config name =
+    let config = { config with replay = Some stdGen }
+    propertyTest "testPropertyWithConfigStdGen" Normal (Some(config,config)) name
+
+  /// Builds a test property.
+  let testProperty name =
+    propertyTest "etestProperty" Normal None name
+
+  /// Builds a test property that will be ignored by Expecto.
+  let ptestProperty name =
+    propertyTest "etestProperty" Pending None name
+
+  /// Builds a test property that will make Expecto to ignore other unfocused tests.
+  let ftestProperty name =
+    propertyTest "etestProperty" Focused None name
+
+  /// Builds a test property that will make Expecto focus on this test use an error stdGen.
+  let etestProperty stdGen name =
+    let config = { FsCheckConfig.defaultConfig with replay = Some stdGen }
+    propertyTest "etestProperty" Focused (Some(config,config)) name
+
+
+type FsCheck =
+  static member Property(name, property: Func<_,bool>) =
+    testProperty name property.Invoke
+
+  static member Property(name, property: Func<_,_,bool>) =
+    testProperty name (fun a b -> property.Invoke(a,b))
+
+  static member Property(name, property: Func<_,_,_,bool>) =
+    testProperty name (fun a b c -> property.Invoke(a,b,c))
+
+  static member Property(name, property: Func<_,_,_,_,bool>) =
+    testProperty name (fun a b c d -> property.Invoke(a,b,c,d))

Expecto.FsCheck3/paket.references

@@ -0,0 +1,2 @@
+group FsCheck3
+FsCheck

Expecto.Tests.FsCheck3/Expecto.Tests.FsCheck3.fsproj

@@ -0,0 +1,15 @@
+<Project Sdk="Microsoft.NET.Sdk">
+  <PropertyGroup>
+    <AssemblyName>Expecto.Tests</AssemblyName>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>net6.0</TargetFramework>
+  </PropertyGroup>
+  <ItemGroup>
+    <Compile Include="FsCheck3Tests.fs" />
+    <Compile Include="Main.fs" />
+    <None Include="paket.references" />
+    <ProjectReference Include="..\Expecto.FsCheck3\Expecto.FsCheck3.fsproj" />
+    <ProjectReference Include="..\Expecto\Expecto.fsproj" />
+  </ItemGroup>
+  <Import Project="..\.paket\Paket.Restore.targets" />
+</Project>

Expecto.Tests.FsCheck3/FsCheck3Tests.fs

@@ -0,0 +1,147 @@
+module Expecto.FsCheckTests
+
+open Expecto
+open Expecto.Impl
+let properties =
+
+  testList "FsCheck" [
+    testProperty "Addition is commutative" <|
+      fun a b ->
+        a + b = b + a
+
+    testProperty "Deliberately failing test" <|
+      fun a b c ->
+        // wrong on purpose to test failures
+        a * (b + c) = a * a + a * c
+
+    testProperty "ignored" <| fun _ ->
+      skiptest "Because I feel like it."
+
+    ptestProperty "ignored2" <| ignore
+
+  ]
+
+[<Tests>]
+let runFsCheckTests =
+  testCaseAsync "run" <| async {
+    let! results = Impl.evalTestsSilent properties
+    Expect.equal results.Length 4 "results length"
+
+    let getResult name =
+      results
+      |> Seq.filter (fun (r,_) -> r.name=name)
+      |> Seq.head
+      |> snd
+
+    Expect.equal (getResult ["FsCheck";"Addition is commutative"]).result
+                 TestResult.Passed "passed count"
+
+    match (getResult ["FsCheck";"Deliberately failing test"]).result with
+    | TestResult.Failed _ ->
+      ()
+    | x ->
+      failtestf "Expected Failed, actual %A" x
+
+    match (getResult ["FsCheck";"ignored"]).result with
+    | TestResult.Ignored e ->
+      Expect.equal "Because I feel like it." e "It should fail with the right message."
+    | x ->
+      failtestf "Expected Ignored, actual %A" x
+
+    match (getResult ["FsCheck";"ignored2"]).result with
+    | TestResult.Ignored _ ->
+      ()
+    | x ->
+      failtestf "Expected Ignored, actual %A" x
+
+  }
+
+let focused =
+  testList "FsCheck focused" [
+    testCase "ignore me" <| ignore
+
+    etestProperty (1,3) "Deliberately failing test" <|
+      fun a b c ->
+        // wrong on purpose to test failures
+        a * (b + c) = a * a + a * c
+  ]
+
+[<Tests>]
+let runFsCheckFocusedTests =
+  testCaseAsync "focused" <| async {
+    let! results = Impl.evalTestsSilent focused
+    Expect.equal results.Length 2 "results length"
+
+    let getResult name =
+      results
+      |> Seq.filter (fun (r,_) -> r.name=name)
+      |> Seq.head
+      |> snd
+
+    match (getResult ["FsCheck focused";"ignore me"]).result with
+    | TestResult.Ignored _ ->
+      ()
+    | x ->
+      failtestf "Expected Ignored, actual %A" x
+
+    match (getResult ["FsCheck focused";"Deliberately failing test"]).result with
+    | TestResult.Failed actual ->
+      let expected = "
+Failed after 3 tests. Parameters:
+	-1 1 2
+Shrunk 2 times to:
+	-1 0 0
+Result:
+	Failed System.Exception: Expected true, got false.
+Focus on error:
+	etestProperty (1, 3) \"Deliberately failing test\""
+      Expect.equal actual expected "It should fail with the right message"
+    | x ->
+      failtestf "Expected Failed, actual was: %A" x
+  }
+
+let config =
+  testList "FsCheck config" [
+    testCase "ignore me" ignore
+
+    etestPropertyWithConfig (1,3) FsCheckConfig.defaultConfig
+      "Deliberately failing test" <|
+      fun a b c ->
+        // wrong on purpose to test failures
+        a * (b + c) = a * a + a * c
+  ]
+
+[<Tests>]
+let runFsCheckConfigTests =
+  testCaseAsync "config" <| async {
+    let! results = Impl.evalTestsSilent config
+    Expect.equal results.Length 2 "results length"
+
+    let getResult name =
+      results
+      |> Seq.filter (fun (r,_) -> r.name=name)
+      |> Seq.head
+      |> snd
+
+    match (getResult ["FsCheck config";"ignore me"]).result with
+    | TestResult.Ignored _ ->
+      ()
+    | x ->
+      failtestf "Expected Ignored, actual %A" x
+
+    match (getResult ["FsCheck config";"Deliberately failing test"]).result with
+    | TestResult.Failed actual ->
+      let expected = "
+Failed after 3 tests. Parameters:
+	-1 1 2
+Shrunk 2 times to:
+	-1 0 0
+Result:
+	Failed System.Exception: Expected true, got false.
+Focus on error:
+	etestPropertyWithConfig (1, 3) \"Deliberately failing test\""
+      Expect.equal actual expected "It should fail with the right message."
+
+    | x ->
+      failtestf "Expected Failed, actual %A" x
+  }