diff --git a/.gitignore b/.gitignore index 92150ba..25f1d49 100644 --- a/.gitignore +++ b/.gitignore @@ -51,4 +51,8 @@ Thumbs.db paket-files # Visual Studio cache/options directory -.vs/ \ No newline at end of file +.vs/ + +# NCrunch +*.ncrunchsolution +*.ncrunchproject \ No newline at end of file diff --git a/src/Hedgehog.Experimental.Xunit.Tests/Hedgehog.Experimental.Xunit.Tests.fsproj b/src/Hedgehog.Experimental.Xunit.Tests/Hedgehog.Experimental.Xunit.Tests.fsproj new file mode 100644 index 0000000..ce72d21 --- /dev/null +++ b/src/Hedgehog.Experimental.Xunit.Tests/Hedgehog.Experimental.Xunit.Tests.fsproj @@ -0,0 +1,32 @@ + + + + netcoreapp3.1 + + + + + + + + + + + runtime; build; native; contentfiles; analyzers; buildtransitive + all + + + runtime; build; native; contentfiles; analyzers; buildtransitive + all + + + + + + + + + + + + diff --git a/src/Hedgehog.Experimental.Xunit.Tests/PropertyTests.fs b/src/Hedgehog.Experimental.Xunit.Tests/PropertyTests.fs new file mode 100644 index 0000000..c39607e --- /dev/null +++ b/src/Hedgehog.Experimental.Xunit.Tests/PropertyTests.fs @@ -0,0 +1,57 @@ +namespace Hedgehog.Experimental.Xunit.Tests + +open Hedgehog.Experimental.Xunit + +module PropertyModuleTests = + + [] + let ``Can generate an int`` (i: int) = + printfn "Test input: %i" i + + [] + let ``Can shrink an int (expect 50)`` (i: int) = + if i >= 50 then failwith "Some error." + + [] + let ``Can generate two ints`` (i1: int, i2: int) = + printfn "Test input: %i, %i" i1 i2 + + [] + let ``Can shrink both ints (expect 10 and 20)`` (i1: int, i2: int) = + if i1 >= 10 && + i2 >= 20 then failwith "Some error." + + [] + let ``Can generate an int and string`` (i: int, s: string) = + printfn "Test input: %i, %s" i s + + [] + 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) = + + [] + let ``Can generate an int`` (i: int) = + sprintf "Test input: %i" i |> output.WriteLine + + [] + let ``Can shrink an int (expect 50)`` (i: int) = + if i >= 50 then failwith "Some error." + + [] + let ``Can generate two ints`` (i1: int, i2: int) = + sprintf "Test input: %i, %i" i1 i2 |> output.WriteLine + + [] + let ``Can shrink both ints (expect 10 and 20)`` (i1: int, i2: int) = + if i1 >= 10 && + i2 >= 20 then failwith "Some error." + + [] + let ``Can generate an int and string`` (i: int, s: string) = + sprintf "Test input: %i, %s" i s |> output.WriteLine + + [] + 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." diff --git a/src/Hedgehog.Experimental.Xunit/ArrayGen.fs b/src/Hedgehog.Experimental.Xunit/ArrayGen.fs new file mode 100644 index 0000000..2a35ebc --- /dev/null +++ b/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." diff --git a/src/Hedgehog.Experimental.Xunit/Hedgehog.Experimental.Xunit.fsproj b/src/Hedgehog.Experimental.Xunit/Hedgehog.Experimental.Xunit.fsproj new file mode 100644 index 0000000..31f0a78 --- /dev/null +++ b/src/Hedgehog.Experimental.Xunit/Hedgehog.Experimental.Xunit.fsproj @@ -0,0 +1,43 @@ + + + + netstandard2.0 + true + true + true + Embedded + True + Apache-2.0 + Hedgehog with batteries for Xunit included. + Christer van der Meeren, Nikos Baxevanis, Jacob Stanley + https://github.com/cmeeren/fsharp-hedgehog-experimental + f# fsharp testing xunit + SQUARE_hedgehog_128x128.png + 0.0.1 + Initial release + + + + + + + + all + runtime; build; native; contentfiles; analyzers; buildtransitive + + + + + + + + + + + + + + + + + diff --git a/src/Hedgehog.Experimental.Xunit/PropertyAttribute.fs b/src/Hedgehog.Experimental.Xunit/PropertyAttribute.fs new file mode 100644 index 0000000..aa770dd --- /dev/null +++ b/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.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) + |> 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() + +[] +[] +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)) + + [] + [] + 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 diff --git a/src/Hedgehog.Experimental.sln b/src/Hedgehog.Experimental.sln index 90a2c5c..a8d2c90 100644 --- a/src/Hedgehog.Experimental.sln +++ b/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