Adding PropertyAttribute for XUnit

.gitignore

@@ -51,4 +51,8 @@ Thumbs.db
 paket-files
 
 # Visual Studio cache/options directory
-.vs/
+.vs/
+
+# NCrunch
+*.ncrunchsolution
+*.ncrunchproject

src/Hedgehog.Experimental.Xunit.Tests/Hedgehog.Experimental.Xunit.Tests.fsproj

@@ -0,0 +1,32 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <TargetFramework>netcoreapp3.1</TargetFramework>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="PropertyTests.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="Microsoft.NET.Test.Sdk" Version="16.8.3" />
+    <PackageReference Include="xunit" Version="2.4.1" />
+    <PackageReference Include="xunit.runner.visualstudio" Version="2.4.3">
+      <IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
+      <PrivateAssets>all</PrivateAssets>
+    </PackageReference>
+    <PackageReference Include="coverlet.collector" Version="1.3.0">
+      <IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
+      <PrivateAssets>all</PrivateAssets>
+    </PackageReference>
+  </ItemGroup>
+
+  <ItemGroup>
+    <ProjectReference Include="..\Hedgehog.Experimental.Xunit\Hedgehog.Experimental.Xunit.fsproj" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Update="FSharp.Core" Version="5.0.0" />
+  </ItemGroup>
+
+</Project>

src/Hedgehog.Experimental.Xunit.Tests/PropertyTests.fs

@@ -0,0 +1,57 @@
+namespace Hedgehog.Experimental.Xunit.Tests
+
+open Hedgehog.Experimental.Xunit
+
+module PropertyModuleTests =
+
+  [<Property>]
+  let ``Can generate an int`` (i: int) =
+    printfn "Test input: %i" i
+
+  [<Property>]
+  let ``Can shrink an int (expect 50)`` (i: int) =
+    if i >= 50 then failwith "Some error."
+
+  [<Property>]
+  let ``Can generate two ints`` (i1: int, i2: int) =
+    printfn "Test input: %i, %i" i1 i2
+
+  [<Property>]
+  let ``Can shrink both ints (expect 10 and 20)`` (i1: int, i2: int) =
+    if i1 >= 10 &&
+       i2 >= 20 then failwith "Some error."
+
+  [<Property>]
+  let ``Can generate an int and string`` (i: int, s: string) =
+    printfn "Test input: %i, %s" i s
+
+  [<Property>]
+  let ``Can shrink an int and string (expect 2 and "b")`` (i: int, s: string) =
+    if i >= 2 && s.Contains "b" then failwith "Some error."
+
+type PropertyClassTests(output: Xunit.Abstractions.ITestOutputHelper) =
+
+  [<Property>]
+  let ``Can generate an int`` (i: int) =
+    sprintf "Test input: %i" i |> output.WriteLine
+
+  [<Property>]
+  let ``Can shrink an int (expect 50)`` (i: int) =
+    if i >= 50 then failwith "Some error."
+
+  [<Property>]
+  let ``Can generate two ints`` (i1: int, i2: int) =
+    sprintf "Test input: %i, %i" i1 i2 |> output.WriteLine
+
+  [<Property>]
+  let ``Can shrink both ints (expect 10 and 20)`` (i1: int, i2: int) =
+    if i1 >= 10 &&
+       i2 >= 20 then failwith "Some error."
+
+  [<Property>]
+  let ``Can generate an int and string`` (i: int, s: string) =
+    sprintf "Test input: %i, %s" i s |> output.WriteLine
+
+  [<Property>]
+  let ``Can shrink an int and string (expect 2 and "b")`` (i: int, s: string) =
+    if i >= 2 && s.Contains "b" then failwith "Some error."

src/Hedgehog.Experimental.Xunit/ArrayGen.fs

@@ -0,0 +1,20 @@
+module internal ArrayGen
+
+open System
+open Hedgehog
+
+let toGenTuple = function
+  | [||] -> failwith "No generators in the list."
+  | [|a|] -> gen {
+    let! a = a
+    return (Tuple.Create a) |> box }
+  | [|a;b|] -> gen {
+    let! a = a
+    let! b = b
+    return (a,b) |> box }
+  | [|a;b;c|] -> gen {
+    let! a = a
+    let! b = b
+    let! c = c
+    return (a,b,c) |> box }
+  | _ -> failwith "Too many generators in the list."

src/Hedgehog.Experimental.Xunit/Hedgehog.Experimental.Xunit.fsproj

@@ -0,0 +1,43 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <TargetFramework>netstandard2.0</TargetFramework>
+    <GeneratePackageOnBuild>true</GeneratePackageOnBuild>
+    <GenerateDocumentationFile>true</GenerateDocumentationFile>
+    <PublishRepositoryUrl>true</PublishRepositoryUrl>
+    <DebugType>Embedded</DebugType>
+    <EmbedAllSources>True</EmbedAllSources>
+    <PackageLicenseExpression>Apache-2.0</PackageLicenseExpression>
+    <Description>Hedgehog with batteries for Xunit included.</Description>
+    <Authors>Christer van der Meeren, Nikos Baxevanis, Jacob Stanley</Authors>
+    <PackageProjectUrl>https://github.com/cmeeren/fsharp-hedgehog-experimental</PackageProjectUrl>
+    <PackageTags>f# fsharp testing xunit</PackageTags>
+    <PackageIcon>SQUARE_hedgehog_128x128.png</PackageIcon>
+    <Version>0.0.1</Version>
+    <PackageReleaseNotes>Initial release</PackageReleaseNotes>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <PackageReference Include="Hedgehog" Version="0.8.4" />
+    <PackageReference Include="xunit" Version="2.4.1" />
+    <PackageReference Include="xunit.abstractions" Version="2.0.3" />
+    <PackageReference Include="xunit.runner.visualstudio" Version="2.4.3">
+      <PrivateAssets>all</PrivateAssets>
+      <IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
+    </PackageReference>
+  </ItemGroup>
+
+  <ItemGroup>
+    <Compile Include="ArrayGen.fs" />
+    <Compile Include="PropertyAttribute.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <ProjectReference Include="..\Hedgehog.Experimental\Hedgehog.Experimental.fsproj" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Update="FSharp.Core" Version="5.0.0" />
+  </ItemGroup>
+
+</Project>

src/Hedgehog.Experimental.Xunit/PropertyAttribute.fs

@@ -0,0 +1,83 @@
+namespace Hedgehog.Experimental.Xunit
+
+open System
+open System.Threading.Tasks
+open Xunit
+open Xunit.Sdk
+open Xunit.Abstractions
+open Hedgehog
+open System.Reflection
+open Microsoft.FSharp.Reflection
+open Xunit.Sdk
+
+module internal PropertyHelper =
+  type MarkerRecord = {``_``:int}
+  let private genxAutoBox<'T> = GenX.auto<'T> |> Gen.map box
+  let private genxAutoBoxMethodInfo =
+    typeof<MarkerRecord>.DeclaringType.GetTypeInfo().DeclaredMethods
+    |> Seq.find (fun meth -> meth.Name = "genxAutoBox")
+
+  let check (methodinfo:MethodInfo) testClassInstance =
+    let gens =
+      methodinfo.GetParameters()
+      |> Array.map (fun p ->
+        genxAutoBoxMethodInfo
+          .MakeGenericMethod(p.ParameterType)
+          .Invoke(null, null)
+        :?> Gen<obj>)
+      |> ArrayGen.toGenTuple
+    let invoke t =
+      methodinfo.Invoke(testClassInstance, FSharpValue.GetTupleFields t)
+      |> function
+      | :? bool as b -> Property.ofBool b
+      | _            -> Property.success ()
+    Property.forAll gens invoke |> Property.check
+
+type PropertyTestInvoker  (test, messageBus, testClass, constructorArguments, testMethod, testMethodArguments, beforeAfterAttributes, aggregator, cancellationTokenSource) =
+  inherit XunitTestInvoker(test, messageBus, testClass, constructorArguments, testMethod, testMethodArguments, beforeAfterAttributes, aggregator, cancellationTokenSource)
+
+  override this.CallTestMethod testClassInstance =
+    PropertyHelper.check this.TestMethod testClassInstance
+    null
+
+type PropertyTestRunner  (test, messageBus, testClass, constructorArguments, testMethod, testMethodArguments, skipReason, beforeAfterAttributes, aggregator, cancellationTokenSource) =
+  inherit XunitTestRunner(test, messageBus, testClass, constructorArguments, testMethod, testMethodArguments, skipReason, beforeAfterAttributes, aggregator, cancellationTokenSource)
+
+  override this.InvokeTestMethodAsync aggregator =
+    PropertyTestInvoker(this.Test, this.MessageBus, this.TestClass, this.ConstructorArguments, this.TestMethod, this.TestMethodArguments, this.BeforeAfterAttributes, aggregator, this.CancellationTokenSource)
+      .RunAsync()
+
+type PropertyTestCaseRunner(testCase: IXunitTestCase, displayName, skipReason, constructorArguments, testMethodArguments, messageBus, aggregator, cancellationTokenSource) =
+  inherit XunitTestCaseRunner(testCase,               displayName, skipReason, constructorArguments, testMethodArguments, messageBus, aggregator, cancellationTokenSource)
+
+  override this.RunTestAsync() =
+    let args = this.TestMethod.GetParameters().Length |> Array.zeroCreate // need to pass the right number of args otherwise an exception will be thrown
+    PropertyTestRunner(this.CreateTest(this.TestCase, this.DisplayName), this.MessageBus, this.TestClass, this.ConstructorArguments, this.TestMethod, args, this.SkipReason, this.BeforeAfterAttributes, this.Aggregator, this.CancellationTokenSource)
+      .RunAsync()
+
+[<AttributeUsage(AttributeTargets.Method ||| AttributeTargets.Property, AllowMultiple = false)>]
+[<XunitTestCaseDiscoverer("Hedgehog.Experimental.Xunit.PropertyTestCaseDiscoverer", "Hedgehog.Experimental.Xunit")>]
+type public PropertyAttribute() =
+  inherit FactAttribute()
+
+open System.ComponentModel
+type PropertyTestCase  (diagnosticMessageSink, defaultMethodDisplay, testMethodDisplayOptions, testMethod, ?testMethodArguments) =
+  inherit XunitTestCase(diagnosticMessageSink, defaultMethodDisplay, testMethodDisplayOptions, testMethod, (testMethodArguments |> Option.defaultValue null))
+
+  [<EditorBrowsable(EditorBrowsableState.Never)>]
+  [<Obsolete("Called by the de-serializer; should only be called by deriving classes for de-serialization purposes")>]
+  new() = new PropertyTestCase(null, TestMethodDisplay.ClassAndMethod, TestMethodDisplayOptions.All, null)
+
+  override this.RunAsync(_, messageBus, constructorArguments, aggregator, cancellationTokenSource) =
+    PropertyTestCaseRunner(this, this.DisplayName, this.SkipReason, constructorArguments, this.TestMethodArguments, messageBus, aggregator, cancellationTokenSource)
+      .RunAsync()
+
+type PropertyTestCaseDiscoverer(messageSink) =
+
+  member _.MessageSink = messageSink
+
+  interface IXunitTestCaseDiscoverer with
+    override this.Discover(discoveryOptions, testMethod, _) =
+      new PropertyTestCase(this.MessageSink, discoveryOptions.MethodDisplayOrDefault(), discoveryOptions.MethodDisplayOptionsOrDefault(), testMethod)
+      :> IXunitTestCase
+      |> Seq.singleton

src/Hedgehog.Experimental.sln

@@ -7,6 +7,10 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Hedgehog.Experimental", "He
 EndProject
 Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Hedgehog.Experimental.Tests", "Hedgehog.Experimental.Tests\Hedgehog.Experimental.Tests.fsproj", "{F0C3240E-6E0F-4A0A-887D-9B1A7632671A}"
 EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Hedgehog.Experimental.Xunit", "Hedgehog.Experimental.Xunit\Hedgehog.Experimental.Xunit.fsproj", "{374D7FA9-5743-4345-B0B9-53C22B235FBF}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Hedgehog.Experimental.Xunit.Tests", "Hedgehog.Experimental.Xunit.Tests\Hedgehog.Experimental.Xunit.Tests.fsproj", "{2704D8DA-45D8-4DFC-9246-28AA20D8700C}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -21,6 +25,14 @@ Global
 		{F0C3240E-6E0F-4A0A-887D-9B1A7632671A}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{F0C3240E-6E0F-4A0A-887D-9B1A7632671A}.Release|Any CPU.ActiveCfg = Release|Any CPU
 		{F0C3240E-6E0F-4A0A-887D-9B1A7632671A}.Release|Any CPU.Build.0 = Release|Any CPU
+		{374D7FA9-5743-4345-B0B9-53C22B235FBF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{374D7FA9-5743-4345-B0B9-53C22B235FBF}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{374D7FA9-5743-4345-B0B9-53C22B235FBF}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{374D7FA9-5743-4345-B0B9-53C22B235FBF}.Release|Any CPU.Build.0 = Release|Any CPU
+		{2704D8DA-45D8-4DFC-9246-28AA20D8700C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{2704D8DA-45D8-4DFC-9246-28AA20D8700C}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{2704D8DA-45D8-4DFC-9246-28AA20D8700C}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{2704D8DA-45D8-4DFC-9246-28AA20D8700C}.Release|Any CPU.Build.0 = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE