diff --git a/.fantomasignore b/.fantomasignore index d9f2aa7f..55452ca5 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -1,2 +1,7 @@ # Ignore AssemblyInfo files AssemblyInfo.fs + +# The Hedgehog MSTest adapter and its suite follow the conventions of hedgehogqa/fsharp-hedgehog, where the same code +# is proposed +tests/Hedgehog.MSTest/ +tests/Hedgehog.MSTest.Tests/ diff --git a/.github/copilot-instructions.md b/.github/copilot-instructions.md index 46978db5..f97a0c1a 100644 --- a/.github/copilot-instructions.md +++ b/.github/copilot-instructions.md @@ -29,6 +29,8 @@ │ └── ValueCollections.fs – `Seq`, `List` and `Array` functions that return `voption` and struct tuples ├── tests/Cosmos.Tests/ – MSTest integration test project ├── tests/Cosmos.Tests.Infrastructure/ – shared test fixtures, emulator settings and assertion helpers +├── tests/Hedgehog.MSTest/ – Hedgehog MSTest adapter for [] test methods (from hedgehogqa/fsharp-hedgehog) +├── tests/Hedgehog.MSTest.Tests/ – the adapter's own test suite ├── build/ – FAKE build scripts └── docsSrc/ – FSharp.Formatting documentation source ``` @@ -40,6 +42,7 @@ * [`FSharp.Control.Reactive`](https://github.com/fsprojects/FSharp.Reactive) – Rx extensions for F# * [`FsToolkit.ErrorHandling`](https://github.com/demystifyfp/FsToolkit.ErrorHandling) – `taskResult`, `Result`, `voption` CEs * [`Unquote`](https://github.com/SwensenSoftware/unquote) – test assertions +* [`Hedgehog`](https://github.com/hedgehogqa/fsharp-hedgehog) – property-based testing through the `tests/Hedgehog.MSTest` adapter * [`MSTest`](https://github.com/microsoft/testfx) – test framework Use GitHub MCP tools for code search in these repositories when needed. @@ -238,7 +241,9 @@ module MyTypeExtensions = * `COSMOS_EMULATOR_PARTITION_COUNT` is the number of partitions the emulator offers (default `25`, the Windows emulator's default `/PartitionCount`); the fixtures keep at most that many test containers at a time, one partition each. * `COSMOS_TEST_LEFTOVER_AGE_MINUTES` is how many minutes a `fsac-test-` database must stay unmodified before the leftover sweep of `[]` and `[]` deletes it (default `60`), so that the live databases of another test process on the same emulator are kept; `0` deletes every test database and is safe only while no other test process uses the emulator. * `COSMOS_REWRITE_BASELINES` set to `1` or `true` makes a test that compares SQL with its golden baseline (`Baseline.assertMatches`, files under `Baselines//` of the test project) write what it produced into the baseline instead of comparing; the test then reports itself inconclusive, the rewritten files are reviewed in the diff, and CI refuses to rewrite. -* Every test project under `tests/` references `tests/Cosmos.Tests.Infrastructure` through `tests/Directory.Build.props`; a new test project gets it without a `ProjectReference` of its own. +* Every test project under `tests/` references `tests/Cosmos.Tests.Infrastructure` through `tests/Directory.Build.props`; a new test project gets it without a `ProjectReference` of its own. The Hedgehog MSTest adapter and its suite are the exception: they stay free of the Cosmos projects, and the suite references the adapter alone. +* Property tests are methods of `[]` types marked `[]` (from `tests/Hedgehog.MSTest`), whose parameters Hedgehog generates; never call `Property.check` inside a `[]`. A property is an instance method that returns `unit`, `Task` or `ValueTask` and fails by throwing: MSTest 4 rejects static methods and other return types, and one such method fails the discovery of the whole assembly, which `--list-tests` shows before a run. MSTest creates the test class and runs `[]` and `[]` for every generated case and every shrink step. A failed property reports a `[]` to add next to its `Property` attribute, which then replays the counterexample. +* `tests/Hedgehog.MSTest` and `tests/Hedgehog.MSTest.Tests` are ported from hedgehogqa/fsharp-hedgehog and proposed there too, so they keep upstream's conventions instead of the rules of this file: nullness checking off and no Fantomas (`.fantomasignore`). Copied files keep their Apache-2.0 header, and `THIRD-PARTY-NOTICES.md` lists them. * `CollectionAssert` cannot work with F# lists – use F# array syntax (`[| ... |]`) instead. * `StringAssert` has overloads with `StringComparison`. * Use `Assert.Contains` instead of `Assert.IsTrue (str.Contains ..., "message")`, and do not put the actual value into the message. diff --git a/Directory.Packages.props b/Directory.Packages.props index 8ceacae9..d025ebb8 100644 --- a/Directory.Packages.props +++ b/Directory.Packages.props @@ -24,6 +24,7 @@ + diff --git a/FSharp.Azure.Cosmos.slnf b/FSharp.Azure.Cosmos.slnf index 1a0488cc..8c92ea12 100644 --- a/FSharp.Azure.Cosmos.slnf +++ b/FSharp.Azure.Cosmos.slnf @@ -4,7 +4,9 @@ "projects": [ "src\\Cosmos\\FSharp.Azure.Cosmos.fsproj", "tests\\Cosmos.Tests.Infrastructure\\FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj", - "tests\\Cosmos.Tests\\FSharp.Azure.Cosmos.Tests.fsproj" + "tests\\Cosmos.Tests\\FSharp.Azure.Cosmos.Tests.fsproj", + "tests\\Hedgehog.MSTest\\Hedgehog.MSTest.fsproj", + "tests\\Hedgehog.MSTest.Tests\\Hedgehog.MSTest.Tests.fsproj" ] } } \ No newline at end of file diff --git a/FSharp.Azure.Cosmos.slnx b/FSharp.Azure.Cosmos.slnx index 4ec89bbd..ad752adf 100644 --- a/FSharp.Azure.Cosmos.slnx +++ b/FSharp.Azure.Cosmos.slnx @@ -8,9 +8,12 @@ + + + diff --git a/THIRD-PARTY-NOTICES.md b/THIRD-PARTY-NOTICES.md new file mode 100644 index 00000000..9bf861c2 --- /dev/null +++ b/THIRD-PARTY-NOTICES.md @@ -0,0 +1,35 @@ +# Third-party notices + +This repository contains code copied from the projects below. Each copied file names its origin and the changes made +to it in a header comment. The rest of the repository is covered by [LICENSE](LICENSE). + +## fsharp-hedgehog + +* Source: , release commit + [`a46977278db9a60542e3df3fe0fcd74b90f38ee3`](https://github.com/hedgehogqa/fsharp-hedgehog/tree/a46977278db9a60542e3df3fe0fcd74b90f38ee3) + (Hedgehog 2.0.4; the repository has no tag for this release) +* Copied into: `tests/Hedgehog.MSTest` (the Hedgehog MSTest adapter), from `src/Hedgehog.NUnit`: `Prelude.fs`, + `ReflectionHelpers.fs`, `AutoGenConfig.fs`, `IPropertyAttribute.fs`, `RecheckAttribute.fs`, `GenAttribute.fs`, + `GenAttribute.Prelude.fs`, `PropertyContext.fs`, `InternalLogic.fs`, `PropertiesAttribute.fs` and, adapted from + NUnit to MSTest, `PropertyAttribute.fs` +* Ported into: `tests/Hedgehog.MSTest.Tests` (the adapter's suite), rewritten for MSTest, from + `tests/Hedgehog.Xunit.Tests.FSharp/PropertyTests.fs`, `tests/Hedgehog.NUnit.Tests.FSharp/PropertyTests.fs` and + `tests/Hedgehog.NUnit.Tests.FSharp/GenAttributePreludeTests.fs`: `Common.fs`, `PropertyTests.fs` and + `GenAttributePreludeTests.fs` +* License: Apache License, Version 2.0 + +```text +Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + +http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +``` diff --git a/build/build.fs b/build/build.fs index ceb7f1e9..bc85979c 100644 --- a/build/build.fs +++ b/build/build.fs @@ -380,6 +380,29 @@ let dotnetTest ctx = (DotNet.MTPTestTarget.Project testProject) ) +/// +/// Lists the tests of every test application without running them. MSTest 4 fails the discovery of a whole assembly +/// when one test method has a signature that it cannot run, such as a property method that returns a value, and the F# +/// build gives no warning for it; listing reports that before the run, which needs the emulator, starts. +/// +let dotnetListTests ctx = + let dotnetConfiguration = configuration (ctx.Context.AllExecutingTargets) |> string + + !!testsGlob + |> Seq.iter (fun testProject -> + [ + "--project" + quoted testProject + "--no-build" + "--configuration" + dotnetConfiguration + "--list-tests" + ] + |> String.concat " " + |> DotNet.exec id "test" + |> failOnBadExitAndPrint + ) + let generateCoverageReport _ = let coverageFiles = @@ -393,8 +416,8 @@ let generateCoverageReport _ = sprintf "-targetdir:\"%s\"" coverageReportDir // Add source dir sprintf "-sourcedirs:\"%s\"" sourceDirs - // Ignore test assemblies and the helper libraries they share - sprintf "-assemblyfilters:\"%s\"" "-*.Tests;-*.Tests.Infrastructure" + // Ignore test assemblies, the helper libraries they share, the Hedgehog MSTest adapter and Hedgehog itself + sprintf "-assemblyfilters:\"%s\"" "-*.Tests;-*.Tests.Infrastructure;-Hedgehog;-Hedgehog.MSTest" // Generate HTML and Cobertura reports sprintf "-reporttypes:%s" "Html;Cobertura" ] @@ -640,6 +663,7 @@ let initTargets (ctx : Context.FakeExecutionContext) = Target.createFinal "DeleteChangelogBackupFile" deleteChangelogBackupFile // Do NOT put this in the dependency chain Target.create "DotnetBuild" dotnetBuild Target.create "FSharpAnalyzers" fsharpAnalyzers + Target.create "DotnetListTests" dotnetListTests Target.create "DotnetTest" dotnetTest Target.create "GenerateCoverageReport" generateCoverageReport Target.create "ShowCoverageReport" showCoverageReport @@ -701,6 +725,7 @@ let initTargets (ctx : Context.FakeExecutionContext) = "DotnetRestore" =?> ("CheckFormatCode", isCI.Value) ==> "DotnetBuild" + ==> "DotnetListTests" ==> "DotnetTest" ==> "DotnetPack" ==> "PublishToNuGet" @@ -711,6 +736,7 @@ let initTargets (ctx : Context.FakeExecutionContext) = =?> ("CheckFormatCode", isCI.Value) =?> ("GenerateAssemblyInfo", isPublishToGitHub) ==> "DotnetBuild" + ==> "DotnetListTests" ==> "DotnetTest" ==> "DotnetPack" ==>! "PublishToGitHub" diff --git a/tests/Directory.Build.props b/tests/Directory.Build.props index 73f3282a..bf524351 100644 --- a/tests/Directory.Build.props +++ b/tests/Directory.Build.props @@ -6,10 +6,14 @@ - + diff --git a/tests/Hedgehog.MSTest.Tests/Common.fs b/tests/Hedgehog.MSTest.Tests/Common.fs new file mode 100644 index 00000000..a6fc9cfe --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/Common.fs @@ -0,0 +1,52 @@ +// The configurations and generator attributes that the tests share, from the suites of hedgehogqa/fsharp-hedgehog at +// the Hedgehog 2.0.4 release commit a46977278db9a60542e3df3fe0fcd74b90f38ee3 (tests/Hedgehog.Xunit.Tests.FSharp and +// tests/Hedgehog.NUnit.Tests.FSharp, PropertyTests.fs). +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the generator attributes carry the Attribute suffix; upstream declares PropertyInt13Attribute and +// PropertiesInt13Attribute next to their tests. + +namespace Hedgehog.MSTest.Tests + +open System +open Hedgehog +open Hedgehog.FSharp +open Hedgehog.MSTest + +/// An AutoGenConfig type whose every int is 13. +type Int13 = + static member __ = AutoGenConfig.defaults |> AutoGenConfig.addGenerator (Gen.constant 13) + +/// An AutoGenConfig type whose every int is 2718. +type Int2718 = + static member __ = AutoGenConfig.empty |> AutoGenConfig.addGenerator (Gen.constant 2718) + +/// An AutoGenConfig type whose every int is 13 and every string is "A". +type Int13A = + static member __ = + AutoGenConfig.empty + |> AutoGenConfig.addGenerator (Gen.constant 13) + |> AutoGenConfig.addGenerator (Gen.constant "A") + +/// Sets an int parameter to 5. +type Int5Attribute() = + inherit GenAttribute() + override _.Generator = Gen.constant 5 + +/// Sets an int parameter to 6. +type Int6Attribute() = + inherit GenAttribute() + override _.Generator = Gen.constant 6 + +/// Generates an int parameter from a constant range. +type IntConstantRangeAttribute(min: int, max: int) = + inherit GenAttribute() + override _.Generator = Range.constant min max |> Gen.int32 + +/// A PropertyAttribute subclass that names Int13 itself. +type PropertyInt13Attribute() = + inherit PropertyAttribute(typeof) + +/// A PropertiesAttribute subclass that names Int13 itself. +type PropertiesInt13Attribute() = + inherit PropertiesAttribute(typeof) diff --git a/tests/Hedgehog.MSTest.Tests/GenAttributePreludeTests.fs b/tests/Hedgehog.MSTest.Tests/GenAttributePreludeTests.fs new file mode 100644 index 00000000..dd64e0fe --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/GenAttributePreludeTests.fs @@ -0,0 +1,114 @@ +// Ported from hedgehogqa/fsharp-hedgehog, tests/Hedgehog.NUnit.Tests.FSharp/GenAttributePreludeTests.fs at the +// Hedgehog 2.0.4 release commit a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/tests/Hedgehog.NUnit.Tests.FSharp/GenAttributePreludeTests.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: rewritten for MSTest assertions; a test of UnicodeString, which upstream does not test, is added, and so are +// tests of NonZeroInt with 0 at either end of its range and from 0 to 0. + +namespace Hedgehog.MSTest.Tests + +open System +open System.Net +open System.Net.Sockets +open Hedgehog.MSTest +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// Ported from upstream's "GenAttribute Prelude tests". +[] +type ``GenAttribute Prelude tests``() = + + [] + member _.``Int attribute generates integers`` ([] i: int) = + Assert.IsInRange(-10, 10, i, "The value lies in the range.") + + [] + member _.``PositiveInt generates positive integers`` ([] i: int) = + Assert.IsGreaterThan(0, i, "The value is positive.") + + [] + member _.``NonNegativeInt generates non-negative integers`` ([] i: int) = + Assert.IsGreaterThanOrEqualTo(0, i, "The value is not negative.") + + [] + member _.``NonZeroInt generates non-zero integers`` ([] i: int) = + Assert.AreNotEqual(0, i, "The value is not zero.") + + [] + member _.``NonZeroInt from 0 generates the positive part of its range`` ([] i: int) = + Assert.IsInRange(1, 5, i, "The value lies in the range and is not zero.") + + [] + member _.``NonZeroInt up to 0 generates the negative part of its range`` ([] i: int) = + Assert.IsInRange(-5, -1, i, "The value lies in the range and is not zero.") + + [] + member _.``NonZeroInt rejects the range from 0 to 0`` () = + Assert.ThrowsExactly( + Action(fun () -> NonZeroIntAttribute(0, 0).Generator |> ignore), + "The range from 0 to 0 holds no non-zero value." + ) + |> ignore + + [] + member _.``OddAttribute generates odd integers`` ([] i: int) = + Assert.AreNotEqual(0, i % 2, "The value is odd.") + + [] + member _.``EvenAttribute generates even integers`` ([] i: int) = + Assert.AreEqual(0, i % 2, "The value is even.") + + [] + member _.``Email generates valid email addresses`` ([] email: string) = + Assert.Contains("@", email, StringComparison.Ordinal, "An email address contains @.") + Assert.Contains(".", email, StringComparison.Ordinal, "An email address contains a dot.") + + [] + member _.``DomainName generates valid domain names`` ([] domain: string) = + Assert.Contains(".", domain, StringComparison.Ordinal, "A domain name contains a dot.") + + [] + member _.``AlphaNumString generates alphanumeric strings`` ([] s: string) = + Assert.IsInRange(5, 20, s.Length, "The length lies in the range.") + Assert.MatchesRegex("^[a-zA-Z0-9]*$", s, "The string holds letters and digits only.") + + [] + member _.``UnicodeString generates strings of the requested length`` ([] s: string) = + Assert.IsInRange(3, 8, s.Length, "The length lies in the range.") + + [] + member _.``Identifier generates valid identifiers`` ([] id: string) = + Assert.IsNotEmpty(id, "An identifier is not empty.") + Assert.IsTrue(Char.IsLetter id[0] || id[0] = '_', "An identifier starts with a letter or an underscore.") + + [] + member _.``LatinName generates Latin names`` ([] name: string) = + Assert.IsNotEmpty(name, "A Latin name is not empty.") + Assert.IsTrue(Char.IsUpper name[0], "A Latin name starts with an uppercase letter.") + + [] + member _.``SnakeCase generates snake_case strings`` ([] s: string) = + if s.Contains("_", StringComparison.Ordinal) then + Assert.MatchesRegex("^[a-z0-9]+(_[a-z0-9]+)*$", s, "Snake case joins lowercase words with underscores.") + + [] + member _.``KebabCase generates kebab-case strings`` ([] s: string) = + if s.Contains("-", StringComparison.Ordinal) then + Assert.MatchesRegex("^[a-z0-9]+(-[a-z0-9]+)*$", s, "Kebab case joins lowercase words with hyphens.") + + [] + member _.``Ipv4Address generates valid IPv4 addresses`` ([] ip: IPAddress) = + Assert.AreEqual(AddressFamily.InterNetwork, ip.AddressFamily, "The address is an IPv4 address.") + + [] + member _.``Ipv6Address generates valid IPv6 addresses`` ([] ip: IPAddress) = + Assert.AreEqual(AddressFamily.InterNetworkV6, ip.AddressFamily, "The address is an IPv6 address.") + + [] + member _.``DateTime generates valid dates`` ([] dt: DateTime) = + Assert.IsInRange(DateTime(2000, 1, 1), DateTime(2010, 1, 1), dt, "The date lies in the default range.") + Assert.AreEqual(DateTimeKind.Utc, dt.Kind, "The date is in UTC.") + + [] + member _.``DateTimeOffset generates valid dates`` ([] dto: DateTimeOffset) = + Assert.IsGreaterThanOrEqualTo(DateTimeOffset(2000, 1, 1, 0, 0, 0, TimeSpan.Zero), dto, "The date lies in the default range.") diff --git a/tests/Hedgehog.MSTest.Tests/Harness.fs b/tests/Hedgehog.MSTest.Tests/Harness.fs new file mode 100644 index 00000000..ecf16d25 --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/Harness.fs @@ -0,0 +1,180 @@ +namespace Hedgehog.MSTest.Tests + +open System +open System.Reflection +open System.Runtime.CompilerServices +open System.Runtime.InteropServices +open System.Threading +open System.Threading.Tasks +open Hedgehog +open Hedgehog.MSTest +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// +/// Runs properties outside the MSTest pipeline through the adapter's entry point +/// , +/// so that a property that fails by design is checked through its result instead of failing the suite. The targets +/// live in classes without , which +/// MSTest does not run. +/// +module internal Harness = + + /// + /// Invokes a test method for one case the way + /// does: on a new instance of the class, awaiting the returned task, with the thrown exception in the result and + /// as an inconclusive result. + /// + let invoker (testMethod: MethodInfo) : obj array -> Task = + fun arguments -> + task { + let instance = + if testMethod.IsStatic then null else Activator.CreateInstance testMethod.ReflectedType + + try + try + match testMethod.Invoke(instance, arguments) with + | :? Task as pending -> do! pending + | :? ValueTask as pending -> do! pending + | _ -> () + + return TestResult(Outcome = UnitTestOutcome.Passed) + with error -> + let error = + match error with + | :? TargetInvocationException as e when not (isNull e.InnerException) -> e.InnerException + | e -> e + + let outcome = + match error with + | :? AssertInconclusiveException -> UnitTestOutcome.Inconclusive + | _ -> UnitTestOutcome.Failed + + return TestResult(Outcome = outcome, TestFailureException = error) + finally + InternalLogic.dispose instance + } + + let private noCancellation () = CancellationToken.None + + /// The public method of the class with the given name. + let methodOf<'Class> (name: string) : MethodInfo = + match typeof<'Class>.GetMethod name with + | null -> invalidArg (nameof name) $"%s{typeof<'Class>.Name} has no public method %s{name}." + | testMethod -> testMethod + + /// The context that the attributes of the method and its class give. + let contextOf<'Class> (name: string) = PropertyContext.fromMethod (methodOf<'Class> name) + + /// Runs the method as PropertyAttribute does and returns its one result. + let executeAsync<'Class> (name: string) : Task = + let testMethod = methodOf<'Class> name + InternalLogic.executeAsync testMethod [||] (invoker testMethod) noCancellation + + /// Runs the method with the given context, with a data row and a cancellation token of the caller's choice. + let runWithAsync + (context: PropertyContext) + (testMethod: MethodInfo) + (invoke: obj array -> Task) + (cancellationToken: unit -> CancellationToken) + : Task = + InternalLogic.runAsync context testMethod [||] invoke cancellationToken + + /// Runs the method with the context its attributes give and returns the run with its report. + let runAsync<'Class> (name: string) : Task = + let testMethod = methodOf<'Class> name + runWithAsync (PropertyContext.fromMethod testMethod) testMethod (invoker testMethod) noCancellation + + /// The parameters that the journal of a failed report names, as name=value. + let parametersOf (report: Report) : string array = + match report.Status with + | Failed failure -> + failure.Journal + |> Journal.eval + |> Seq.choose (function + | TestParameter(name, value) -> Some $"%s{name}=%O{value}" + | _ -> None) + |> Seq.toArray + | status -> raise (AssertFailedException $"The property must fail, but its status is %A{status}.") + + /// The message of the exception of a result, or an empty string. + let messageOf (result: TestResult) = + match result.TestFailureException with + | null -> "" + | error -> error.Message + +/// +/// Runs a property that fails by design through the real MSTest pipeline and turns the expected failure into a passed +/// result, so that the suite pins what reports through MSTest itself: +/// exactly one result, its outcome, its message, its output and the type of its inner exception. Any other result fails +/// the test and shows the property's own result. +/// +type FailingPropertyAttribute + /// + /// Expects the property to fail. + /// + /// The file that declares the test method; the compiler fills it in. + /// The line that declares the test method; the compiler fills it in. + ( + [] callerFilePath: string, + [] callerLineNumber: int + ) = + inherit PropertyAttribute(callerFilePath, callerLineNumber) + + /// The expected outcome; Failed unless set. + member val Outcome = UnitTestOutcome.Failed with get, set + + /// Texts that the failure message contains. + member val MessageContains: string array = [||] with get, set + + /// Texts that the output of the result contains: its standard output or its TestContext messages. + member val OutputContains: string array = [||] with get, set + + /// The type of the inner exception of the failure, or null for no check. + member val InnerException: Type = null with get, set + + /// Runs the property and checks its result. + override this.ExecuteAsync(testMethod: ITestMethod) : Task = + // base cannot be used inside the task expression, which is a closure + let run = base.ExecuteAsync testMethod + + task { + let! results = run + + let describe () = + results + |> Seq.map (fun result -> + $"Outcome: %O{result.Outcome}%s{Environment.NewLine}%s{Harness.messageOf result}%s{Environment.NewLine}%s{result.LogOutput}%s{result.TestContextMessages}") + |> String.concat Environment.NewLine + + let verdict = + try + Assert.HasCount(1, results, "A property must report exactly one result.") + let result = results[0] + Assert.AreEqual(this.Outcome, result.Outcome, "The property must end with the expected outcome.") + Assert.IsNotNull(result.TestFailureException, "A property that does not pass must report an exception.") + let message = result.TestFailureException.Message + + for expected in this.MessageContains do + Assert.Contains(expected, message, StringComparison.Ordinal, "The failure message must contain the expected text.") + + // TestContext.WriteLine goes to the TestContext messages, Console output to the standard output + let output = result.LogOutput + Environment.NewLine + result.TestContextMessages + + for expected in this.OutputContains do + Assert.Contains(expected, output, StringComparison.Ordinal, "The output must contain the expected text.") + + match this.InnerException with + | null -> () + | expectedType -> + Assert.IsInstanceOfType( + result.TestFailureException.InnerException, + expectedType, + "The failure must carry the exception of the counterexample as its inner exception." + ) + + TestResult(Outcome = UnitTestOutcome.Passed, LogOutput = "The property failed as expected." + Environment.NewLine + describe ()) + with :? AssertFailedException as error -> + TestResult(Outcome = UnitTestOutcome.Failed, TestFailureException = error, LogOutput = describe ()) + + return [| verdict |] + } diff --git a/tests/Hedgehog.MSTest.Tests/Hedgehog.MSTest.Tests.fsproj b/tests/Hedgehog.MSTest.Tests/Hedgehog.MSTest.Tests.fsproj new file mode 100644 index 00000000..76d9e29d --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/Hedgehog.MSTest.Tests.fsproj @@ -0,0 +1,43 @@ + + + + + net10.0 + disable + + Exe + true + false + true + + + + + PreserveNewest + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/Hedgehog.MSTest.Tests/MSTestTests.fs b/tests/Hedgehog.MSTest.Tests/MSTestTests.fs new file mode 100644 index 00000000..7eeea694 --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/MSTestTests.fs @@ -0,0 +1,555 @@ +// Tests of what the MSTest adapter adds to upstream's adapters or does differently (ADR 0001, section 22.6): one result +// per property, the lifecycle of every case, failure reports and their replay, Seed, give-ups, Assert.Inconclusive, +// rejected methods, Task and ValueTask bodies, data rows, settings of inherited properties, generator attributes found +// through the inheritance chain, memoised invocations, cancellation and timeouts. Each pins MSTest behaviour that the +// adapter relies on, so the suite runs on every MSTest update. +namespace Hedgehog.MSTest.Tests + +open System +open System.Threading +open System.Threading.Tasks +open Hedgehog +open Hedgehog.MSTest +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// The function under test of the failure report tests: it loses the last item of a list of three or more items. +module Buggy = + let reverse (xs: int list) = + let reversed = List.rev xs + if reversed.Length >= 3 then List.truncate (reversed.Length - 1) reversed else reversed + +/// The recheck data that the seed-42 run of the buggy reverse property reports. +module BuggyRecheck = + [] + let Data = "33_7178138842248401496_3704456211830240771_4-4-4" + +/// Records what the lifecycle test class does, one instance number per case. +module LifecycleRecord = + let mutable constructed = 0 + let mutable lastBodyInstance = 0 + let mutable lastCleanedUp = 0 + let mutable lastDisposed = 0 + +/// MSTest runs the constructor, the TestContext injection, TestInitialize, TestCleanup and Dispose for every case. +[] +type ``Lifecycle per case tests``() = + let instance = Interlocked.Increment &LifecycleRecord.constructed + let mutable initialized = false + let mutable bodies = 0 + + member val TestContext: TestContext = null with get, set + + [] + member _.Initialize() = initialized <- true + + [] + member _.Cleanup() = LifecycleRecord.lastCleanedUp <- instance + + interface IDisposable with + member _.Dispose() = LifecycleRecord.lastDisposed <- instance + + [)>] + member this.``every case gets its own instance, TestContext, TestInitialize, TestCleanup and Dispose`` (_: int) = + bodies <- bodies + 1 + Assert.AreEqual(1, bodies, "An instance runs a single case.") + Assert.IsTrue(initialized, "TestInitialize runs before every case.") + Assert.IsNotNull(this.TestContext, "MSTest injects the TestContext for every case.") + + Assert.AreEqual( + "every case gets its own instance, TestContext, TestInitialize, TestCleanup and Dispose", + this.TestContext.TestName, + "The TestContext names the property." + ) + + match LifecycleRecord.lastBodyInstance with + | 0 -> () + | previous -> + Assert.AreNotEqual(previous, instance, "Every case runs on a new instance.") + Assert.AreEqual(previous, LifecycleRecord.lastCleanedUp, "TestCleanup ran after the previous case.") + Assert.AreEqual(previous, LifecycleRecord.lastDisposed, "Dispose ran after the previous case.") + + LifecycleRecord.lastBodyInstance <- instance + +/// MSTest passes the TestContext to the constructor of every case as well. +[] +type ``TestContext constructor injection tests``(testContext: TestContext) = + + [)>] + member _.``MSTest passes the TestContext to the constructor of every case`` (_: bool) = + Assert.IsNotNull(testContext, "MSTest passes the TestContext to the constructor.") + +/// A failed property reports Hedgehog's report, its counterexample, recheck data ready to paste, the exception of the +/// counterexample and the output of its invocation, and RecheckAttribute replays it. +[] +type ``Failure report tests``() = + static let mutable fixedRuns = 0 + + member val TestContext: TestContext = null with get, set + + [)>] + member this.``a failed property reports its counterexample, its recheck data and the output of its invocation`` (i: int) = + this.TestContext.WriteLine $"invocation output for %d{i}" + Assert.IsLessThan(50, i, "fails by design from 50") + + []" |])>] + member _.``the buggy reverse reports the recheck data that the tests below replay`` (xs: int list) = + CollectionAssert.AreEqual(List.toArray xs, List.toArray (Buggy.reverse (Buggy.reverse xs)), "Reversing twice must give the list back.") + + [)>] + [] + member _.``Recheck replays the counterexample`` (xs: int list) = + CollectionAssert.AreEqual(List.toArray xs, List.toArray (Buggy.reverse (Buggy.reverse xs)), "Reversing twice must give the list back.") + + [] + [] + member _.``Recheck passes with a single case once the bug is fixed`` (xs: int list) = + Assert.AreEqual(1, Interlocked.Increment &fixedRuns, "A recheck replays exactly one case.") + CollectionAssert.AreEqual(List.toArray xs, List.toArray (List.rev (List.rev xs)), "Reversing twice must give the list back.") + + [] + [] + member _.``a failed data row names its row values among the parameters`` (row: int, i: int) = + Assert.IsLessThan(10, i, "fails by design from 10") + + [] + [] + member _.``malformed recheck data gives an error result`` (i: int) = Assert.AreEqual(i, i, "never reached") + + [] + member _.``a property that gives up fails`` (n: int) : unit = Assert.Inconclusive $"never applicable (%d{n})" + +/// Counts the instances of CancelledCaseArgument and their disposals. +module CancelledCaseCounters = + let mutable created = 0 + let mutable disposed = 0 + +/// A generated argument of the cancellation tests, which counts its instances and their disposals. +type CancelledCaseArgument() = + do Interlocked.Increment &CancelledCaseCounters.created |> ignore + + interface IDisposable with + member _.Dispose() = Interlocked.Increment &CancelledCaseCounters.disposed |> ignore + +/// Targets of the harness tests, which fail by design or cannot run. +type HarnessTargets() = + + [)>] + member _.``takes a disposable argument`` (_: CancelledCaseArgument) = () + + [] + member _.``buggy reverse`` (xs: int list) = + CollectionAssert.AreEqual(List.toArray xs, List.toArray (Buggy.reverse (Buggy.reverse xs)), "Reversing twice must give the list back.") + + [)>] + member _.``seed 42`` (_: int, _: string) = () + + [)>] + member _.``seed 7`` (_: int, _: string) = () + + [] + member _.``fails from 50`` (i: int) : unit = + if i >= 50 then + failwith "fails by design" + + [] + member _.``always inconclusive`` (n: int) : unit = Assert.Inconclusive $"never applicable (%d{n})" + + [)>] + member _.``odd values are discarded`` (n: int) : unit = + if n % 2 <> 0 then + Assert.Inconclusive "odd values do not apply" + + [] + [] + member _.``inconclusive in a recheck`` (_: int) : unit = Assert.Inconclusive "a recheck cannot discard its case" + + [] + member _.``fails for any value`` (_: int) : unit = Assert.Fail "fails by design" + + [] + member _.``generic property`` (value: 'a) : unit = ignore value + + [] + member _.``returns bool`` (_: int) = true + + [] + member _.``returns Task of unit`` (_: int) : Task = task { return () } + + [] + member _.``returns Async`` (_: int) = async { return () } + + [] + member _.``returns Result`` (_: int) : Result = Ok() + +/// Targets of the caller information tests, one for each constructor of PropertyAttribute. +type CallerInformationTargets() = + + [] + member _.``no arguments`` () = () + + [)>] + member _.``tests`` () = () + + [, 0)>] + member _.``tests and shrinks`` () = () + + [)>] + member _.``AutoGenConfig`` () = () + + [, 5)>] + member _.``AutoGenConfig and tests`` () = () + + [, 5, 0)>] + member _.``AutoGenConfig, tests and shrinks`` () = () + +/// PropertyAttribute passes the caller information of each of its constructors on to TestMethodAttribute, which records +/// where the test method is declared. +[] +type ``Caller information tests``() = + + [] + [] + [] + [] + [] + [] + [] + member _.``a property records the file and the line that declare it`` (name: string) = + let attribute = + Harness.methodOf name + |> fun testMethod -> testMethod.GetCustomAttributes(typeof, false) + |> Seq.exactlyOne + :?> PropertyAttribute + + StringAssert.EndsWith(attribute.DeclaringFilePath, "MSTestTests.fs", StringComparison.Ordinal, "The attribute records the declaring file.") + Assert.IsTrue(attribute.DeclaringLineNumber.HasValue, "The attribute records the declaring line.") + Assert.IsGreaterThan(0, attribute.DeclaringLineNumber.Value, "The declaring line is a line of the file.") + +/// The behaviour of the runner, driven through the adapter's entry point with an invoker of the suite's own. +[] +type ``Runner tests``() = + + /// Runs a target with an invoker that records the arguments of every invocation. + let recordAsync name : Task = + task { + let testMethod = Harness.methodOf name + let invoke = Harness.invoker testMethod + let recorded = ResizeArray() + + let recording (arguments: obj array) = + recorded.Add(arguments |> Array.map (fun argument -> $"%A{argument}") |> String.concat ", ") + invoke arguments + + let! run = Harness.runWithAsync (PropertyContext.fromMethod testMethod) testMethod recording (fun () -> CancellationToken.None) + return struct (run, recorded.ToArray()) + } + + [] + member _.``the same Seed generates the same cases, another Seed others`` () : Task = + task { + let! struct (_, first) = recordAsync "seed 42" + let! struct (_, second) = recordAsync "seed 42" + let! struct (_, other) = recordAsync "seed 7" + Assert.HasCount(20, first, "The property runs its 20 cases.") + CollectionAssert.AreEqual(first, second, "The same seed generates the same cases.") + CollectionAssert.AreNotEqual(first, other, "Another seed generates other cases.") + } + + [] + member _.``the recheck data of a failed run replays its counterexample in one invocation`` () : Task = + task { + let! run = Harness.runAsync "buggy reverse" + + let recheckData = + match run.Report.Status with + | Failed { RecheckInfo = Some info } -> RecheckData.serialize info.Data + | status -> raise (AssertFailedException $"The property must fail with recheck data, but its status is %A{status}.") + + Assert.AreEqual(BuggyRecheck.Data, recheckData, "The seed fixes the recheck data that the failure report tests replay.") + let testMethod = Harness.methodOf "buggy reverse" + let context = { PropertyContext.fromMethod testMethod with Recheck = Some recheckData } + let! replay = Harness.runWithAsync context testMethod (Harness.invoker testMethod) (fun () -> CancellationToken.None) + Assert.AreEqual(1, replay.Invocations, "A recheck replays exactly one case.") + + CollectionAssert.AreEqual( + Harness.parametersOf run.Report, + Harness.parametersOf replay.Report, + "The recheck replays the counterexample of the run." + ) + } + + [] + member _.``the counterexample is invoked once`` () : Task = + task { + let! struct (run, recorded) = recordAsync "fails from 50" + CollectionAssert.AreEqual([| "i=50" |], Harness.parametersOf run.Report, "The property shrinks to 50.") + Assert.ContainsSingle((fun arguments -> arguments = "50"), recorded, "Hedgehog must not invoke the counterexample again to read its journal.") + |> ignore + Assert.HasCount(run.Invocations, recorded, "The run counts every invocation.") + } + + [] + member _.``a property that gives up fails`` () : Task = + task { + let! result = Harness.executeAsync "always inconclusive" + Assert.AreEqual(UnitTestOutcome.Failed, result.Outcome, "A property that gives up fails, as in upstream's adapters.") + Assert.Contains("Gave up after 100 discards", Harness.messageOf result, StringComparison.Ordinal, "The message is Hedgehog's report.") + } + + [] + member _.``Assert.Inconclusive discards the case`` () : Task = + task { + let! run = Harness.runAsync "odd values are discarded" + Assert.AreEqual(Status.OK, run.Report.Status, "Discarded cases do not fail the property.") + Assert.AreEqual(20, run.Report.Tests, "The property runs its 20 cases that apply.") + Assert.IsGreaterThan(0, run.Report.Discards, "The odd values are discarded.") + } + + [] + member _.``Assert.Inconclusive in a recheck fails`` () : Task = + task { + let! result = Harness.executeAsync "inconclusive in a recheck" + Assert.AreEqual(UnitTestOutcome.Failed, result.Outcome, "A recheck cannot discard its only case.") + + Assert.IsInstanceOfType( + result.TestFailureException.InnerException, + "The failure carries the exception of Assert.Inconclusive." + ) + |> ignore + } + + [] + member _.``a cancelled token stops the run without shrinking`` () : Task = + task { + use cancellation = new CancellationTokenSource() + // Fails from 50 only, so its first failing case has smaller values to shrink to + let testMethod = Harness.methodOf "fails from 50" + let invoke = Harness.invoker testMethod + + // Cancels the token when an invocation fails, as a [] does when it ends one + let cancelling (arguments: obj array) = + task { + let! result = invoke arguments + + if result.Outcome <> UnitTestOutcome.Passed then + cancellation.Cancel() + + return result + } + + let! run = Harness.runWithAsync (PropertyContext.fromMethod testMethod) testMethod cancelling (fun () -> cancellation.Token) + Assert.IsTrue(run.Cancelled, "The run notices the cancelled token.") + + match run.Report.Status with + | Failed failure -> Assert.AreEqual(0, failure.Shrinks, "No shrink step runs once the token is cancelled.") + | status -> Assert.Fail $"The property must fail, but its status is %A{status}." + + Assert.AreEqual(int run.Report.Tests, run.Invocations, "Only the generated cases are invoked, no shrink step.") + let result = InternalLogic.toTestResult run TimeSpan.Zero + Assert.AreEqual(UnitTestOutcome.Failed, result.Outcome, "A stopped property fails.") + + Assert.Contains( + $"stopped after %d{run.Invocations} invocations without shrinking", + Harness.messageOf result, + StringComparison.Ordinal, + "The message explains why the property stopped." + ) + } + + [] + member _.``a case that a cancelled token keeps from running still disposes its arguments`` () : Task = + task { + use cancellation = new CancellationTokenSource() + cancellation.Cancel() + let testMethod = Harness.methodOf "takes a disposable argument" + + let! run = + Harness.runWithAsync (PropertyContext.fromMethod testMethod) testMethod (Harness.invoker testMethod) (fun () -> cancellation.Token) + + Assert.IsTrue(run.Cancelled, "The run notices the cancelled token.") + Assert.AreEqual(0, run.Invocations, "No case runs once the token is cancelled.") + Assert.AreNotEqual(0, CancelledCaseCounters.created, "Arguments are generated for the cases that do not run.") + Assert.AreEqual(CancelledCaseCounters.created, CancelledCaseCounters.disposed, "Every generated argument is disposed.") + } + + [] + member _.``a generic property method gives an error result`` () : Task = + task { + let! result = Harness.executeAsync "generic property" + Assert.AreEqual(UnitTestOutcome.Error, result.Outcome, "A generic method cannot run as a property.") + Assert.Contains("is generic", Harness.messageOf result, StringComparison.Ordinal, "The message names the rule.") + } + + [] + [] + [] + [] + [] + member _.``a return type that MSTest cannot run gives an error result`` (name: string, advice: string) : Task = + task { + let! result = Harness.executeAsync name + Assert.AreEqual(UnitTestOutcome.Error, result.Outcome, "MSTest cannot run such a method.") + Assert.Contains(advice, Harness.messageOf result, StringComparison.Ordinal, "The message tells what to return instead.") + } + +/// MSTest reports Assert.Inconclusive as an inconclusive invocation, which the adapter turns into a discarded case. +[] +type ``Inconclusive tests``() = + + [)>] + member _.``odd values are discarded`` (n: int) = + if n % 2 <> 0 then + Assert.Inconclusive "odd values do not apply" + + Assert.AreEqual(0, n % 2, "Only even values get past the precondition.") + +/// Task and ValueTask bodies run through MSTest, which awaits them; the shrinking tests cover their failures. +[] +type ``Task and ValueTask tests``() = + + [)>] + member _.``a Task property runs`` (i: int) : Task = + task { + do! Task.Yield() + Assert.AreEqual(i, i + 0, "Adding zero keeps the value.") + } + + [)>] + member _.``a ValueTask property runs`` (i: int) : ValueTask = + Assert.AreEqual(i, i * 1, "Multiplying by one keeps the value.") + ValueTask.CompletedTask + +/// The rows of the data row tests. +module DataRows = + let labels: obj array seq = seq { [| box "first" |]; [| box "second" |] } + + let typed: TestDataRow seq = + seq { + TestDataRow(struct ("one", 1)) + TestDataRow(struct ("two", 2)) + } + +/// The values of an MSTest data row are the leading arguments, and the parameters after them are generated. +[] +type ``Data row tests``() = + + static member Labels = DataRows.labels + + static member Typed = DataRows.typed + + [)>] + [] + [] + member _.``DataRow values are the leading arguments`` (fixedValue: int, _: int list) = + Assert.IsTrue((fixedValue = 3 || fixedValue = 5), "The leading argument comes from the data row.") + + [)>] + [] + member _.``DynamicData values are the leading arguments`` (label: string, _: bool) = + Assert.IsTrue((label = "first" || label = "second"), "The leading argument comes from the data row.") + + [)>] + [] + member _.``a TestDataRow of a struct tuple fills two leading parameters`` (name: string, count: int, _: int) = + Assert.IsTrue((name = "one" && count = 1) || (name = "two" && count = 2), "The two leading arguments come from the row.") + +/// The base of two test classes whose class-level settings differ; the property is declared here once. +[] +type InheritedPropertySuite() = + abstract Expected: int + + [)>] + member this.``an inherited property gets the settings of the class that MSTest runs`` (i: int) = + Assert.AreEqual(this.Expected, i, "The config of the derived test class sets every int.") + +/// Runs the inherited property with Int13. +[] +[)>] +type ``Inherited property with Int13``() = + inherit InheritedPropertySuite() + override _.Expected = 13 + +/// Runs the inherited property with Int2718. +[] +[)>] +type ``Inherited property with Int2718``() = + inherit InheritedPropertySuite() + override _.Expected = 2718 + +/// The base class of the settings precedence tests. +[, AutoGenConfig = typeof, Seed = 1UL)>] +type SettingsBase() = + + [] + member _.``declared in the base class`` (i: int, s: string) = + Assert.AreEqual(2718, i, "The derived class's config wins for ints.") + Assert.AreEqual("A", s, "The base class's config still sets every string.") + +/// The derived class of the settings precedence tests. +[, AutoGenConfig = typeof)>] +type SettingsDerived() = + inherit SettingsBase() + +/// A derived class's Properties win over its base class's, and the configurations merge. +[] +type ``Class-level settings precedence tests``() = + + [] + member _.``a base class alone sets its own settings`` () = + let context = Harness.contextOf "declared in the base class" + Assert.AreEqual(Some 3, context.Tests, "The base class sets the number of tests.") + Assert.AreEqual(Some 1UL, context.Seed, "The base class sets the seed.") + + [] + member _.``a derived class's settings win over its base class's`` () = + let context = Harness.contextOf "declared in the base class" + Assert.AreEqual(Some 7, context.Tests, "The derived class's number of tests wins.") + Assert.AreEqual(Some 1UL, context.Seed, "A setting the derived class leaves out comes from the base class.") + + [] + member _.``a derived class's configuration merges over its base class's`` () : Task = + task { + let! run = Harness.runAsync "declared in the base class" + Assert.AreEqual(Status.OK, run.Report.Status, "The merged configuration generates 2718 and \"A\".") + Assert.AreEqual(7, run.Report.Tests, "The derived class's number of tests applies.") + } + +/// A generator attribute derived from the built-in IntAttribute, which upstream's adapters overlook. +type OneToThreeAttribute() = + inherit IntAttribute(1, 3) + +/// A GenAttribute is found wherever it sits in the inheritance chain. +[] +type ``GenAttribute inheritance tests``() = + + [] + member _.``an attribute derived from a built-in one sets the value`` ([] i: int) = + Assert.IsInRange(1, 3, i, "The derived attribute bounds the value.") + +/// A [] applies to each invocation, and a timed-out invocation stops the property without shrinking. The +/// TestCleanup method makes MSTest replace the token source of the TestContext before it, which the adapter must survive. +[] +type ``Timeout tests``() = + + member val TestContext: TestContext = null with get, set + + [] + member _.Cleanup() = () + + [)>] + [] + member this.``a timeout applies to each invocation, not to the property`` (_: int) : Task = + Task.Delay(100, this.TestContext.CancellationToken) + + [, MessageContains = [| "stopped after 1 invocations without shrinking" |])>] + [] + member this.``a timed-out invocation stops the property without shrinking`` (_: int) : Task = + Task.Delay(TimeSpan.FromSeconds 30.0, this.TestContext.CancellationToken) diff --git a/tests/Hedgehog.MSTest.Tests/PropertyTests.fs b/tests/Hedgehog.MSTest.Tests/PropertyTests.fs new file mode 100644 index 00000000..37455860 --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/PropertyTests.fs @@ -0,0 +1,672 @@ +// Ported from hedgehogqa/fsharp-hedgehog at the Hedgehog 2.0.4 release commit a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// tests/Hedgehog.Xunit.Tests.FSharp/PropertyTests.fs and tests/Hedgehog.NUnit.Tests.FSharp/PropertyTests.fs, +// https://github.com/hedgehogqa/fsharp-hedgehog/tree/a46977278db9a60542e3df3fe0fcd74b90f38ee3/tests +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: rewritten for MSTest. Properties are instance members of [] types and fail by throwing; a target +// that fails by design lives in a class without [] and runs through Harness. Left out are the cases MSTest 4 +// cannot discover (bool, Result, Async, Task<'T> and Property return values, unresolved generic parameters, +// module-level properties), the xUnit discoverer and tryRaise tests, and the in-body Property.check test. The targets +// that must shrink once fix their seed, because a random first failure of exactly 2500 cannot shrink. Added are tests of +// a generic config parameter used for two arguments, nested in an array type, and given two types. The misspellings +// "overriden", "properites" and "arg get disposed" in test names are corrected. + +namespace Hedgehog.MSTest.Tests + +open System +open System.Threading +open System.Threading.Tasks +open Hedgehog +open Hedgehog.FSharp +open Hedgehog.MSTest +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// Targets of the shrinking tests, which fail by design. +type ShrinkTargets() = + + [] + member _.``fails for any value`` (value: int) : unit = Assert.Fail "fails by design" + + [] + member _.``fails from 50`` (i: int) : unit = + if i >= 50 then + failwith "Some error." + + [] + member _.``fails when both ints are large`` (i1: int, i2: int) : unit = + if i1 >= 10 && i2 >= 20 then + failwith "Some error." + + [)>] + member _.``fails for an int and a string`` (i: int, s: string) : unit = + if i >= 2 && s.Contains("b", StringComparison.Ordinal) then + failwith "Some error." + + [] + member _.``Task fails above 10`` (i: int) : Task = + if i > 10 then + raise (System.Exception()) + else + Task.Delay 2 + + [] + member _.``task expression fails above 10`` (i: int) : Task = + task { + do! Task.Delay 2 + + if i > 10 then + raise (System.Exception()) + } + + [] + member _.``ValueTask fails above 10`` (i: int) : ValueTask = + if i > 10 then + ValueTask.FromException(System.Exception()) + else + ValueTask.CompletedTask + +/// Ported from the shrinking tests of upstream's "Property module tests" and "Asynchronous tests". +[] +type ``Shrinking tests``() = + + let assertShrunk name (expected: string array) : Task = + task { + let! run = Harness.runAsync name + CollectionAssert.AreEqual(expected, Harness.parametersOf run.Report, "The property must shrink to the smallest counterexample.") + } + + [] + member _.``fails and shrinks an int to 0`` () : Task = + assertShrunk (nameof Unchecked.defaultof.``fails for any value``) [| "value=0" |] + + [] + member _.``Can shrink an int`` () : Task = + assertShrunk (nameof Unchecked.defaultof.``fails from 50``) [| "i=50" |] + + [] + member _.``Can shrink both ints`` () : Task = + assertShrunk (nameof Unchecked.defaultof.``fails when both ints are large``) [| "i1=10"; "i2=20" |] + + [] + member _.``Can shrink an int and string`` () : Task = + assertShrunk (nameof Unchecked.defaultof.``fails for an int and a string``) [| "i=2"; "s=b" |] + + [] + member _.``Returning Task with exception fails`` () : Task = + assertShrunk (nameof Unchecked.defaultof.``Task fails above 10``) [| "i=11" |] + + [] + member _.``task expression with exception shrinks`` () : Task = + assertShrunk (nameof Unchecked.defaultof.``task expression fails above 10``) [| "i=11" |] + + [] + member _.``ValueTask with exception shrinks`` () : Task = + assertShrunk (nameof Unchecked.defaultof.``ValueTask fails above 10``) [| "i=11" |] + +/// The record of the 26-parameter property. +type CustomRecord = { Herp: int; Derp: string } + +/// Ported from the generating tests of upstream's "Property module tests" and "Property class tests". +[] +type ``Property class tests``() = + + member val TestContext: TestContext = null with get, set + + [] + member this.``Can generate an int`` (i: int) = this.TestContext.WriteLine $"Test input: %i{i}" + + [] + member this.``Can generate two ints`` (i1: int, i2: int) = + this.TestContext.WriteLine $"Test input: %i{i1}, %i{i2}" + + [] + member this.``Can generate an int and string`` (i: int, s: string) = + this.TestContext.WriteLine $"Test input: %i{i}, %s{s}" + + [] + member this.``Works up to 26 parameters`` + ( + a: string, + b: char, + c: double, + d: bool, + e: DateTime, + f: DateTimeOffset, + g: string list, + h: char list, + i: int, + j: int array, + k: char array, + l: DateTime array, + m: DateTimeOffset array, + n: CustomRecord option, + o: DateTime option, + p: Result, + q: Result, + r: Result, + s: Result, + t: Result, + u: Result, + v: Result, + w: Result, + x: Result, + y: CustomRecord, + z: int list list + ) = + this.TestContext.WriteLine + $"%A{a} %A{b} %A{c} %A{d} %A{e} %A{f} %A{g} %A{h} %A{i} %A{j} %A{k} %A{l} %A{m} %A{n} %A{o} %A{p} %A{q} %A{r} %A{s} %A{t} %A{u} %A{v} %A{w} %A{x} %A{y} %A{z} " + + [] + member _.``0 parameters passes`` () = () + +/// Targets of the AutoGenConfig and context tests, which these tests inspect without running them. +type ConfigTargets() = + + [, 1)>] + member _.``runs with 13 once`` () = () + + [)>] + member _.``Instance property fails`` () = () + + [)>] + member _.``Non AutoGenConfig static property fails`` () = () + +/// An AutoGenConfig type whose member is not static, which the adapter rejects. +and NonstaticProperty = + member _.__ = AutoGenConfig.defaults + +/// An AutoGenConfig type whose static member does not return an AutoGenConfig, which the adapter rejects. +and NonAutoGenConfig = + static member __ = () + +/// Ported from upstream's "Property module with AutoGenConfig tests". +[] +type ``Property AutoGenConfig tests``() = + + let expectedMessage (configType: Type) = + $"%s{configType.FullName} must have exactly one public static property that returns an AutoGenConfig." + + """ + +An example type definition: + +""" + + $"type %s{configType.Name} =" + + """ + static member __ = + AutoGenConfig.defaults |> AutoGenConfig.addGenerator (Gen.constant 13) +""" + + [)>] + member _.``Uses custom Int gen`` (i: int) = Assert.AreEqual(13, i, "Int13 sets every int to 13.") + + [)>] + member _.``Uses custom Int gen with named arg`` (i: int) = Assert.AreEqual(13, i, "Int13 sets every int to 13.") + + [] + member _.``Tests 'runs with 13 once'`` () = + let context = Harness.contextOf (nameof Unchecked.defaultof.``runs with 13 once``) + Assert.AreEqual(Some 1, context.Tests, "The attribute sets the number of tests.") + Assert.AreEqual(None, context.Shrinks, "The attribute sets no shrink limit.") + let generated = Gen.autoWith context.AutoGenConfig |> Gen.sample 1 1 |> Seq.exactlyOne + Assert.AreEqual(13, generated, "The attribute's config generates 13.") + + [] + member _.``Instance property fails`` () = + let error = + Assert.Throws( + (fun () -> Harness.contextOf (nameof Unchecked.defaultof.``Instance property fails``) |> ignore), + "An AutoGenConfig type without a static member is rejected." + ) + + Assert.AreEqual(expectedMessage typeof, error.Message, "The message explains the rule.") + + [] + member _.``Non AutoGenConfig static property fails`` () = + let error = + Assert.Throws( + (fun () -> + Harness.contextOf (nameof Unchecked.defaultof.``Non AutoGenConfig static property fails``) + |> ignore), + "An AutoGenConfig type whose member returns something else is rejected." + ) + + Assert.AreEqual(expectedMessage typeof, error.Message, "The message explains the rule.") + + [] + member _.``an invalid AutoGenConfig type gives an error result`` () : Task = + task { + let! result = Harness.executeAsync (nameof Unchecked.defaultof.``Instance property fails``) + Assert.AreEqual(UnitTestOutcome.Error, result.Outcome, "A property that cannot run is an error.") + Assert.Contains("must have exactly one public static property", Harness.messageOf result, StringComparison.Ordinal, "The message explains the rule.") + } + +/// An AutoGenConfig type that takes the value of its char generator as an argument. +type ConfigArg = + static member __ a = AutoGenConfig.defaults |> AutoGenConfig.addGenerator (Gen.constant a) + +/// AutoGenConfig types whose members take generic, concrete and mixed arguments. +module ConfigArgs = + let config a b = + AutoGenConfig.defaults + |> AutoGenConfig.addGenerator (Gen.constant a) + |> AutoGenConfig.addGenerator (Gen.constant b) + + type ConfigGenericArgs = static member __ (a: 'a) (b: 'b) = config a b + type ConfigArgs = static member __ (a: string) (b: int) = config a b + type ConfigMixedArgsA = static member __ (a: 'a) (b: int) = config a b + type ConfigMixedArgsB = static member __ (a: string) (b: 'b) = config a b + + /// One generic parameter for two arguments: each generated value is one of them. + type ConfigRepeatedGeneric = + static member __ (a: 'a) (b: 'a) = AutoGenConfig.defaults |> AutoGenConfig.addGenerator (Gen.item [ a; b ]) + + /// A generic parameter nested in the array type of the argument: each generated value is one of its items. + type ConfigNestedGeneric = + static member __ (items: 'a[]) = AutoGenConfig.defaults |> AutoGenConfig.addGenerator (Gen.item items) + +/// Ported from upstream's "AutoGenConfigArgs tests". +[] +[, AutoGenConfigArgs = [| 'a' |])>] +type ``AutoGenConfigArgs tests``() = + + let test (s: string) (i: int) = + Assert.AreEqual("foo", s, "The config arguments set every string.") + Assert.AreEqual(13, i, "The config arguments set every int.") + + [] + member _.``PropertiesAttribute passes its AutoGenConfigArgs`` (a: char) = + Assert.AreEqual('a', a, "The class-level config arguments set every char.") + + [, AutoGenConfigArgs = [| "foo"; 13 |])>] + member _.``all generics`` (s: string, i: int) = test s i + + [, AutoGenConfigArgs = [| "foo"; 13 |])>] + member _.``all non-generics`` (s: string, i: int) = test s i + + [, AutoGenConfigArgs = [| "foo"; 13 |])>] + member _.``mixed generics, 1`` (s: string, i: int) = test s i + + [, AutoGenConfigArgs = [| "foo"; 13 |])>] + member _.``mixed generics, 2`` (s: string, i: int) = test s i + + [, AutoGenConfigArgs = [| "foo"; "bar" |])>] + member _.``one generic parameter for two arguments`` (s: string) = + CollectionAssert.Contains([| "foo"; "bar" |], s, "Both arguments of the one generic parameter supply the strings.") + + [] + member _.``a generic parameter nested in an array type`` () = + let config = Hedgehog.MSTest.AutoGenConfig.instantiate typeof [| box [| 13; 14 |] |] + let values = Gen.autoWith config |> Gen.sample 10 20 |> Array.ofSeq + // IsSubsetOf counts repeated items, so the distinct values are compared + CollectionAssert.IsSubsetOf(Array.distinct values, [| 13; 14 |], "The items of the array argument supply every int.") + + [] + member _.``a generic parameter must get one type from all of its arguments`` () = + let error = + Assert.Throws( + Action(fun () -> + Hedgehog.MSTest.AutoGenConfig.instantiate typeof [| box "foo"; box 13 |] + |> ignore), + "Two types for one generic parameter cannot instantiate the config." + ) + + Assert.Contains("gets both System.String and System.Int32", error.Message, StringComparison.Ordinal, "The message names both types.") + +/// Targets of the class-level settings tests, which these tests inspect without running them. +[, 200)>] +type ClassPropertiesTargets() = + + [] + member _.``Class Properties works`` (_: int) = () + + [)>] + member _.``Class Properties tests (count) is overridden by Method Property`` (_: int) = () + +/// Targets of the named-argument tests. +[, AutoGenConfig = typeof)>] +type NamedArgumentTargets() = + + [] + member _.``runs once with 13`` () = () + +/// Targets of the tests-count tests. +[)>] +type TestsCountTargets() = + + [] + member _.``runs once`` () = () + +/// Ported from upstream's "Module with tests", "Properties named arg tests" and "Properties (tests count) +/// tests". +[] +type ``Class-level settings tests``() = + + [] + member _.``Class Properties tests (count) works`` () = + let context = Harness.contextOf (nameof Unchecked.defaultof.``Class Properties works``) + Assert.AreEqual(Some 200, context.Tests, "The class sets the number of tests.") + + [] + member _.``Class Properties tests (count) is overridden by Method Property`` () = + let context = + Harness.contextOf + (nameof Unchecked.defaultof.``Class Properties tests (count) is overridden by Method Property``) + + Assert.AreEqual(Some 300, context.Tests, "The method's number of tests wins over the class's.") + + [] + member _.``Tests 'runs once with 13'`` () = + let context = Harness.contextOf (nameof Unchecked.defaultof.``runs once with 13``) + Assert.AreEqual(Some 1, context.Tests, "The named argument sets the number of tests.") + let generated = Gen.autoWith context.AutoGenConfig |> Gen.sample 1 1 |> Seq.exactlyOne + Assert.AreEqual(13, generated, "The named argument's config generates 13.") + + [] + member _.``Tests 'runs once'`` () = + let context = Harness.contextOf (nameof Unchecked.defaultof.``runs once``) + Assert.AreEqual(Some 1, context.Tests, "The constructor argument sets the number of tests.") + +/// Ported from upstream's "Class with tests". +[] +[)>] +type ``Class with Properties tests``() = + + [] + member _.``Class Properties works`` (i: int) = Assert.AreEqual(13, i, "The class's config sets every int.") + + [)>] + member _.``Class Properties is overridden by Method level Property`` (i: int) = + Assert.AreEqual(2718, i, "The method's config wins over the class's.") + +/// Ported from upstream's "Property inheritance tests". +[] +type ``Property inheritance tests``() = + + [] + member _.``Property inheritance works`` (i: int) = Assert.AreEqual(13, i, "The derived attribute's config sets every int.") + +/// Ported from upstream's "Properties inheritance tests". +[] +[] +type ``Properties inheritance tests``() = + + [] + member _.``Properties inheritance works`` (i: int) = Assert.AreEqual(13, i, "The derived attribute's config sets every int.") + +/// Ported from upstream's "Module with )>". +[] +[)>] +type ``Class with Properties of Int13A``() = + + [] + member _.``Class's Properties works`` (i: int, s: string) = + Assert.AreEqual(13, i, "The class's config sets every int.") + Assert.AreEqual("A", s, "The class's config sets every string.") + + [)>] + member _.``Class's Properties merges with Method level Property`` (i: int, s: string) = + Assert.AreEqual(2718, i, "The method's config wins for ints.") + Assert.AreEqual("A", s, "The class's config still sets every string.") + +/// An AutoGenConfig type whose every int * int tuple is (1, 2). +type CustomTupleGen = + static member __ = AutoGenConfig.defaults |> AutoGenConfig.addGenerator (Gen.constant (1, 2)) + +/// Ported from upstream's "TupleTests". +[] +type ``Tuple tests``() = + + [)>] + member _.``a tuple parameter takes its generator from the config`` ((a, b): int * int, _: bool) = + Assert.AreEqual(1, a, "The config sets the first item.") + Assert.AreEqual(2, b, "The config sets the second item.") + +/// The seed of the targets that must shrink once. With a random seed, a run whose first failing value is exactly 2500 has +/// no smaller failing value to shrink to and ends after zero shrinks, about one run in 2500. +module ShrinkSeed = + [] + let Value = 1UL + +/// Targets of the shrink-limit tests, which fail by design. +type ShrinksTargets() = + + [, 0)>] + member _.``0 shrinks`` (i: int) = Assert.IsLessThan(2500, i, "fails by design for large values") + + [, Seed = ShrinkSeed.Value)>] + member _.``1 shrinks, run`` (i: int) = Assert.IsLessThan(2500, i, "fails by design for large values") + + [, 100, 0)>] + member _.``0 shrinks, run`` () : unit = failwith "oops" + +/// An AutoGenConfig type whose every string is "...". +type Forever = + static member __ = AutoGenConfig.defaults |> AutoGenConfig.addGenerator (Gen.constant "...") + +/// Targets of the class-level shrink-limit tests, set through the (config, tests, shrinks) constructor. +[, 100, 0)>] +type ClassShrinksTargets() = + + [] + member _.``0 shrinks`` (i: int) = Assert.IsLessThan(2500, i, "fails by design for large values") + + [, Seed = ShrinkSeed.Value)>] + member _.``1 shrinks, run`` (i: int) = Assert.IsLessThan(2500, i, "fails by design for large values") + +/// Targets of the class-level shrink-limit tests, set through the named argument. +[)>] +type ClassNamedShrinksTargets() = + + [] + member _.``0 shrinks`` (i: int) = Assert.IsLessThan(2500, i, "fails by design for large values") + + [, Seed = ShrinkSeed.Value)>] + member _.``1 shrinks, run`` (i: int) = Assert.IsLessThan(2500, i, "fails by design for large values") + +/// Targets of the class-level shrink-limit tests, set through the (tests, shrinks) constructor. +[, 0)>] +type ClassTestsShrinksTargets() = + + [] + member _.``0 shrinks`` (i: int) = Assert.IsLessThan(2500, i, "fails by design for large values") + + [, Seed = ShrinkSeed.Value)>] + member _.``1 shrinks, run`` (i: int) = Assert.IsLessThan(2500, i, "fails by design for large values") + +/// Ported from upstream's "ShrinkTests" and the three "Module with tests ... shrinks" modules. +[] +type ``Shrink limit tests``() = + + let assertShrinks (expected: int) (run: InternalLogic.PropertyRun) = + match run.Report.Status with + | Failed data -> Assert.AreEqual(expected, data.Shrinks, "The shrink limit bounds the shrink steps.") + | status -> Assert.Fail $"The property must fail, but its status is %A{status}." + + [] + member _.``0 shrinks`` () = + let context = Harness.contextOf (nameof Unchecked.defaultof.``0 shrinks``) + Assert.AreEqual(Some 0, context.Shrinks, "The attribute sets the shrink limit.") + + [] + member _.``1 shrinks, run`` () : Task = + task { + let! run = Harness.runAsync (nameof Unchecked.defaultof.``1 shrinks, run``) + assertShrinks 1 run + } + + [] + member _.``0 shrinks, run`` () : Task = + task { + let! run = Harness.runAsync (nameof Unchecked.defaultof.``0 shrinks, run``) + assertShrinks 0 run + } + + [] + [] + [] + [] + member _.``Class Properties sets 0 shrinks`` (constructor: string) = + let context = + match constructor with + | "config, tests and shrinks" -> Harness.contextOf "0 shrinks" + | "named argument" -> Harness.contextOf "0 shrinks" + | _ -> Harness.contextOf "0 shrinks" + + Assert.AreEqual(Some 0, context.Shrinks, "The class sets the shrink limit.") + + [] + member _.``Method Property overrides the class's 0 shrinks`` () : Task = + task { + let! configRun = Harness.runAsync "1 shrinks, run" + assertShrinks 1 configRun + let! namedRun = Harness.runAsync "1 shrinks, run" + assertShrinks 1 namedRun + let! testsRun = Harness.runAsync "1 shrinks, run" + assertShrinks 1 testsRun + } + +/// The recheck data of the recheck tests. +module RecheckData = + [] + let Expected = "0_16700074754810023652_2867022503662193831_" + +/// Targets of the recheck context tests. +type RecheckTargets() = + + [] + [] + member _.recheck () = () + + [] + [] + member _.``Recheck's Size overrides Property's Size, 99`` (_: int) = () + + [] + [] + member _.``Recheck's Size overrides Property's Size, 1`` (_: int) = () + +/// Ported from upstream's "RecheckTests". +[] +type ``Recheck tests``() = + static let mutable runs = 0 + + [] + member _.recheck () = + let context = Harness.contextOf (nameof Unchecked.defaultof.recheck) + Assert.AreEqual(Some RecheckData.Expected, context.Recheck, "The attribute supplies the recheck data.") + + [] + [] + member _.``recheck runs once`` (_: int) = + Assert.AreEqual(1, Interlocked.Increment &runs, "A recheck replays exactly one case.") + + [] + member _.``Recheck's Size overrides Property's Size`` () = + // The context keeps the Size of the attribute; the recheck data carries its own size, which the run uses + let size99 = Harness.contextOf "Recheck's Size overrides Property's Size, 99" + let size1 = Harness.contextOf "Recheck's Size overrides Property's Size, 1" + Assert.AreEqual(Some 1, size99.Size, "The context sees the attribute's Size.") + Assert.AreEqual(Some 99, size1.Size, "The context sees the attribute's Size.") + Assert.AreEqual("99", size99.Recheck.Value.Split('_')[0], "The recheck data carries size 99.") + Assert.AreEqual("1", size1.Recheck.Value.Split('_')[0], "The recheck data carries size 1.") + +/// Targets of the size tests. +[] +type SizeTargets() = + + [] + member _.``property size, actual`` () = () + + [] + member _.``properties size, actual`` () = () + +/// Ported from upstream's "SizeTests". +[] +type ``Size tests``() = + + [] + member _.``property size`` () = + let context = Harness.contextOf (nameof Unchecked.defaultof.``property size, actual``) + Assert.AreEqual(Some 2, context.Size, "The method's Size wins over the class's.") + + [] + member _.``properties size`` () = + let context = Harness.contextOf (nameof Unchecked.defaultof.``properties size, actual``) + Assert.AreEqual(Some 1, context.Size, "The class's Size applies.") + +/// Counts the instances of DisposableImplementation and their disposals. +module DisposableCounters = + let mutable runs = 0 + let mutable disposes = 0 + +/// A generated argument that counts its disposal. +type DisposableImplementation() = + interface IDisposable with + member _.Dispose() = Interlocked.Increment &DisposableCounters.disposes |> ignore + +/// Targets of the IDisposable test, which fails by design. +type DisposableTargets() = + + [] + member _.``IDisposable arg gets disposed even if exception thrown`` (_: DisposableImplementation, i: int) = + Interlocked.Increment &DisposableCounters.runs |> ignore + + if i > 10 then + raise (System.Exception()) + +/// Ported from upstream's "IDisposable test module". +[] +type ``IDisposable tests``() = + + [] + member _.``IDisposable arg gets disposed even if exception thrown`` () : Task = + task { + let! run = + Harness.runAsync + (nameof Unchecked.defaultof.``IDisposable arg gets disposed even if exception thrown``) + + Assert.IsTrue((match run.Report.Status with Failed _ -> true | _ -> false), "The property fails by design.") + Assert.AreNotEqual(0, DisposableCounters.runs, "The property runs.") + Assert.AreEqual(DisposableCounters.runs, DisposableCounters.disposes, "Every generated argument is disposed.") + } + +/// An attribute on a parameter that is not a generator. +type OtherAttribute() = + inherit Attribute() + +/// Ported from upstream's "GenAttribute Tests". +[] +type ``GenAttribute tests``() = + + [] + member _.``can set parameter as 5`` ([] i: int) = Assert.AreEqual(5, i, "The attribute sets the value.") + + [)>] + member _.``overrides Property's autoGenConfig`` ([] i: int) = + Assert.AreEqual(5, i, "The attribute wins over the method's config.") + + [] + member _.``can have different generators for the same parameter type`` ([] five: int, [] six: int) = + Assert.AreEqual(5, five, "The first attribute sets the first value.") + Assert.AreEqual(6, six, "The second attribute sets the second value.") + + [] + member _.``can restrict on range`` ([] i: int) = + Assert.IsInRange(0, 5, i, "The attribute bounds the value.") + + [] + member _.``Doesn't error with OtherAttribute`` ([] i: int) = + Assert.AreEqual(5, i, "Another attribute on the parameter does not hide the generator.") + +/// Ported from upstream's "GenAttribute with Properties Tests". +[] +[)>] +type ``GenAttribute with Properties tests``() = + + [] + member _.``overrides Properties' autoGenConfig`` ([] i: int) = + Assert.AreEqual(5, i, "The attribute wins over the class's config.") + + [)>] + member _.``overrides Properties' and Property's autoGenConfig`` ([] i: int) = + Assert.AreEqual(5, i, "The attribute wins over both configs.") diff --git a/tests/Hedgehog.MSTest.Tests/testconfig.json b/tests/Hedgehog.MSTest.Tests/testconfig.json new file mode 100644 index 00000000..ba207a05 --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/testconfig.json @@ -0,0 +1,9 @@ +{ + "mstest": { + "parallelism": { + "enabled": true, + "scope": "method", + "workers": 0 + } + } +} diff --git a/tests/Hedgehog.MSTest/AutoGenConfig.fs b/tests/Hedgehog.MSTest/AutoGenConfig.fs new file mode 100644 index 00000000..786d3247 --- /dev/null +++ b/tests/Hedgehog.MSTest/AutoGenConfig.fs @@ -0,0 +1,101 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/AutoGenConfig.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/AutoGenConfig.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the generic arguments of a config method are +// inferred from wherever each generic parameter occurs in the parameter types, nested ones such as 'a[] included, and +// every occurrence must give the same type, where upstream takes one argument type per parameter that is itself a +// generic parameter. + +namespace Hedgehog.MSTest + +open System +open System.Reflection +open Hedgehog + +module internal AutoGenConfig = + + // Infers the generic arguments of a generic config method from the runtime types of the arguments it is given + let private inferGenericArguments (methodInfo: MethodInfo) (configArgs: obj array) : Type array = + let parameters = methodInfo.GetParameters() + + if parameters.Length <> configArgs.Length then + failwith + $"%s{methodInfo.DeclaringType.FullName}.%s{methodInfo.Name} takes %d{parameters.Length} arguments, but AutoGenConfigArgs gives %d{configArgs.Length}." + + let genericParameters = methodInfo.GetGenericArguments() + let inferred: Type option array = Array.create genericParameters.Length None + + let rec baseTypes (t: Type) = + seq { + match t.BaseType with + | null -> () + | baseType -> + yield baseType + yield! baseTypes baseType + } + + let rec unify (parameterType: Type) (argumentType: Type) = + if parameterType.IsGenericParameter then + let position = parameterType.GenericParameterPosition + + match inferred.[position] with + | None -> inferred.[position] <- Some argumentType + | Some earlier when earlier = argumentType -> () + | Some earlier -> + failwith + $"The generic parameter %s{parameterType.Name} of %s{methodInfo.Name} gets both %s{earlier.FullName} and %s{argumentType.FullName} from AutoGenConfigArgs." + elif parameterType.IsArray && argumentType.IsArray then + unify (parameterType.GetElementType()) (argumentType.GetElementType()) + elif parameterType.IsGenericType && parameterType.ContainsGenericParameters then + // The argument's own type, a base type or an interface built from the same generic definition + let definition = parameterType.GetGenericTypeDefinition() + + seq { + yield argumentType + yield! baseTypes argumentType + yield! argumentType.GetInterfaces() + } + |> Seq.tryFind (fun t -> t.IsGenericType && t.GetGenericTypeDefinition() = definition) + |> Option.iter (fun constructed -> + Array.iter2 unify (parameterType.GetGenericArguments()) (constructed.GetGenericArguments())) + + Array.iter2 + (fun (parameter: ParameterInfo) (configArg: obj) -> + if not (isNull configArg) then + unify parameter.ParameterType (configArg.GetType())) + parameters + configArgs + + inferred + |> Array.mapi (fun index inferredType -> + match inferredType with + | Some t -> t + | None -> + failwith + $"The generic parameter %s{genericParameters.[index].Name} of %s{methodInfo.Name} cannot be inferred from AutoGenConfigArgs.") + + let instantiate (configType: Type) (configArgs: obj array) = + let configArgs = configArgs |> Option.ofObj |> Option.defaultValue [||] + + configType.GetMethods() + |> Seq.filter (fun p -> p.IsStatic && p.ReturnType = typeof) + |> Seq.seqTryExactlyOne + |> Option.requireSome + $"%s{configType.FullName} must have exactly one public static property that returns an AutoGenConfig. + +An example type definition: + +type %s{configType.Name} = + static member __ = + AutoGenConfig.defaults |> AutoGenConfig.addGenerator (Gen.constant 13) +" + |> fun methodInfo -> + let methodInfo = + if methodInfo.IsGenericMethod then + methodInfo.MakeGenericMethod(inferGenericArguments methodInfo configArgs) + else + methodInfo + + methodInfo.Invoke(null, configArgs) :?> IAutoGenConfig diff --git a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs new file mode 100644 index 00000000..f7f9e01b --- /dev/null +++ b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs @@ -0,0 +1,429 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/GenAttribute.Prelude.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/GenAttribute.Prelude.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the documentation of the attributes is +// rewritten; NonZeroInt skips a 0 at either end of its range, where upstream generates from an empty part, and rejects +// the range from 0 to 0. + +namespace Hedgehog.MSTest + +open System +open Hedgehog +open Hedgehog.FSharp + +[] +module private RangeHelpers = + + [] + let private LargeRangeThreshold = 1000L + [] + let private MediumRangeThreshold = 100L + + /// Choose between constant, linear, and exponential range based on the range size. + /// - For ranges > 1000: use exponential to ensure boundary values are tested + /// - For ranges > 100: use linear for balanced shrinking + /// - For ranges <= 100: use constant (no shrinking needed for small ranges) + let inline chooseRangeInt32 (min: int) (max: int) : Range = + let rangeSize = int64 max - int64 min + let origin = if min <= 0 && 0 <= max then 0 else min + match rangeSize with + | size when size > LargeRangeThreshold -> Range.exponentialFrom origin min max + | size when size > MediumRangeThreshold -> Range.linearFrom origin min max + | _ -> Range.constantFrom origin min max + +/// +/// Generates an from to , both included. +/// +/// +/// The range is exponential when it spans more than 1000 values, linear when it spans more than 100 and constant +/// otherwise; it shrinks towards 0 when it contains 0 and towards otherwise. +/// +type IntAttribute + /// + /// Creates the attribute. + /// + /// The smallest value. + /// The largest value. + (min: int, max: int) = + inherit GenAttribute() + /// + /// Generates an from to + /// . + /// + new() = IntAttribute(Int32.MinValue, Int32.MaxValue) + /// + override _.Generator = + Gen.int32 (chooseRangeInt32 min max) + +/// +/// Generates an odd : a value from to with its +/// lowest bit set, so it can exceed by one. +/// +/// +/// The range is chosen as for . +/// +type OddAttribute + /// + /// Creates the attribute. + /// + /// The smallest value before the lowest bit is set. + /// The largest value before the lowest bit is set. + (min: int, max: int) = + inherit GenAttribute() + /// + /// Generates an odd from the whole range of . + /// + new() = OddAttribute(Int32.MinValue, Int32.MaxValue) + /// + override _.Generator = gen { + let! n = Gen.int32 (chooseRangeInt32 min max) + return n ||| 1 + } + +/// +/// Generates an even : a value from to with +/// its lowest bit cleared, so it can fall below by one. +/// +/// +/// The range is chosen as for . +/// +type EvenAttribute + /// + /// Creates the attribute. + /// + /// The smallest value before the lowest bit is cleared. + /// The largest value before the lowest bit is cleared. + (min: int, max: int) = + inherit GenAttribute() + /// + /// Generates an even from the whole range of . + /// + new() = EvenAttribute(Int32.MinValue, Int32.MaxValue) + /// + override _.Generator = gen { + let! n = Gen.int32 (chooseRangeInt32 min max) + return n &&& ~~~1 + } + +/// +/// Generates a positive from 1 to . +/// +/// +/// The range is chosen as for . +/// +type PositiveIntAttribute + /// + /// Creates the attribute. + /// + /// The largest value. + (max: int) = + inherit GenAttribute() + /// + /// Generates a positive from 1 to . + /// + new() = PositiveIntAttribute(Int32.MaxValue) + /// + override _.Generator = + Gen.int32 (chooseRangeInt32 1 max) + +/// +/// Generates a non-negative from 0 to . +/// +/// +/// The range is chosen as for . +/// +type NonNegativeIntAttribute + /// + /// Creates the attribute. + /// + /// The largest value. + (max: int) = + inherit GenAttribute() + /// + /// Generates a non-negative from 0 to . + /// + new() = NonNegativeIntAttribute(Int32.MaxValue) + /// + override _.Generator = + Gen.int32 (chooseRangeInt32 0 max) + +/// +/// Generates a non-zero from to . +/// +/// +/// A 0 at either end of the range is skipped. A range with 0 inside is split into its negative and its positive part, +/// and each generated value comes from one of them; each part is chosen as for +/// . The range from 0 to 0 holds no non-zero value and is rejected. +/// +type NonZeroIntAttribute + /// + /// Creates the attribute. + /// + /// The smallest value. + /// The largest value. + (min: int, max: int) = + inherit GenAttribute() + /// + /// Generates a non-zero from + 1 to + /// . + /// + new() = NonZeroIntAttribute(Int32.MinValue + 1, Int32.MaxValue) + /// + override _.Generator = + match min, max with + | 0, 0 -> invalidArg (nameof min) "The range from 0 to 0 holds no non-zero value." + | _, m when m < 0 -> Gen.int32 (chooseRangeInt32 min max) // Range entirely negative + | n, _ when n > 0 -> Gen.int32 (chooseRangeInt32 min max) // Range entirely positive + | 0, m -> Gen.int32 (chooseRangeInt32 1 m) // 0 is the lowest value, skip it + | n, 0 -> Gen.int32 (chooseRangeInt32 n -1) // 0 is the highest value, skip it + | n, m -> // 0 lies inside the range, split it + Gen.choice [ + Gen.int32 (chooseRangeInt32 n -1) + Gen.int32 (chooseRangeInt32 1 m) + ] + +/// +/// Generates a that is a valid identifier, through +/// . +/// +type IdentifierAttribute + /// + /// Creates the attribute. + /// + /// The largest length. + (maxLen: int) = + inherit GenAttribute() + /// + /// Generates an identifier of up to 25 characters. + /// + new() = IdentifierAttribute(25) + /// + override _.Generator = + Gen.identifier maxLen + +/// +/// Generates a that is a Latin name, through +/// . +/// +type LatinNameAttribute + /// + /// Creates the attribute. + /// + /// The largest length. + (maxLength: int) = + inherit GenAttribute() + /// + /// Generates a Latin name of up to 20 characters. + /// + new() = LatinNameAttribute(20) + /// + override _.Generator = + Gen.latinName maxLength + +/// +/// Generates a in snake case, such as snake_case, through +/// . +/// +type SnakeCaseAttribute + /// + /// Creates the attribute. + /// + /// The largest length of one word. + /// The largest number of words. + (maxWordLength: int, maxWordsCount: int) = + inherit GenAttribute() + /// + /// Generates up to 5 words of up to 5 characters each in snake case. + /// + new() = SnakeCaseAttribute(5, 5) + /// + override _.Generator = + Gen.snakeCase (Range.constant 1 maxWordLength) (Range.constant 1 maxWordsCount) + +/// +/// Generates a in kebab case, such as kebab-case, through +/// . +/// +type KebabCaseAttribute + /// + /// Creates the attribute. + /// + /// The largest length of one word. + /// The largest number of words. + (maxWordLength: int, maxWordsCount: int) = + inherit GenAttribute() + /// + /// Generates up to 5 words of up to 5 characters each in kebab case. + /// + new() = KebabCaseAttribute(5, 5) + /// + override _.Generator = + Gen.kebabCase (Range.constant 1 maxWordLength) (Range.constant 1 maxWordsCount) + +/// +/// Generates a that is a valid domain name, through +/// . +/// +type DomainNameAttribute + /// + /// Creates the attribute. + /// + () = + inherit GenAttribute() + /// + override _.Generator = + Gen.domainName + +/// +/// Generates a that is a valid email address, through +/// . +/// +type EmailAttribute + /// + /// Creates the attribute. + /// + () = + inherit GenAttribute() + /// + override _.Generator = + Gen.email + +/// +/// Generates a of the given from to +/// plus . +/// +type DateTimeAttribute + /// + /// Creates the attribute. + /// + /// The of every value. + /// The earliest value. + /// How much later than the latest value is. + (kind: DateTimeKind, from: DateTime, duration: TimeSpan) = + inherit GenAttribute() + /// + /// Generates a of kind within the 3650 days + /// from 2000-01-01. + /// + new() = DateTimeAttribute(DateTimeKind.Utc, DateTime(2000, 1, 1), TimeSpan.FromDays(3650)) + /// + /// Generates a of kind from + /// to plus . + /// + /// The earliest value. + /// How much later than the latest value is. + new(from, duration) = DateTimeAttribute(DateTimeKind.Utc, from, duration) + /// + /// Generates a of the given within the 3650 days from + /// 2000-01-01. + /// + /// The of every value. + new(kind) = DateTimeAttribute(kind, DateTime(2000, 1, 1), TimeSpan.FromDays(3650)) + /// + override _.Generator = + Gen.dateTime (Range.constant from (from + duration)) (Gen.constant kind) + +/// +/// Generates a from to plus +/// . +/// +type DateTimeOffsetAttribute + /// + /// Creates the attribute. + /// + /// The earliest value. + /// How much later than the latest value is. + (from: DateTimeOffset, duration: TimeSpan) = + inherit GenAttribute() + /// + /// Generates a with offset zero within the 3650 days from 2000-01-01. + /// + new() = DateTimeOffsetAttribute(DateTimeOffset(2000, 1, 1, 0, 0, 0, TimeSpan.Zero), TimeSpan.FromDays(3650)) + /// + /// Generates a within the 3650 days from . + /// + /// The earliest value. + new(from) = DateTimeOffsetAttribute(from, TimeSpan.FromDays(3650)) + /// + override _.Generator = + Gen.dateTimeOffset (Range.constant from (from + duration)) + +/// +/// Generates a of ASCII letters and digits, from to +/// characters long. +/// +type AlphaNumStringAttribute + /// + /// Creates the attribute. + /// + /// The smallest length. + /// The largest length. + (minLength: int, maxLength: int) = + inherit GenAttribute() + /// + /// Generates a of ASCII letters and digits, up to 256 characters long. + /// + new() = AlphaNumStringAttribute(0, 256) + /// + /// Generates a of ASCII letters and digits, from to 256 + /// characters long. + /// + /// The smallest length. + new(minLength) = AlphaNumStringAttribute(minLength, 256) + /// + override _.Generator = + Gen.string (Range.constant minLength maxLength) Gen.alphaNum + +/// +/// Generates a of Unicode characters, from to +/// characters long. +/// +type UnicodeStringAttribute + /// + /// Creates the attribute. + /// + /// The smallest length. + /// The largest length. + (minLength: int, maxLength: int) = + inherit GenAttribute() + /// + /// Generates a of Unicode characters, up to 256 characters long. + /// + new() = UnicodeStringAttribute(0, 256) + /// + /// Generates a of Unicode characters, from to 256 + /// characters long. + /// + /// The smallest length. + new(minLength) = UnicodeStringAttribute(minLength, 256) + /// + override _.Generator = + Gen.string (Range.constant minLength maxLength) Gen.unicode + +/// +/// Generates an IPv4 , through . +/// +type Ipv4AddressAttribute + /// + /// Creates the attribute. + /// + () = + inherit GenAttribute() + /// + override _.Generator = + Gen.ipv4Address + +/// +/// Generates an IPv6 , through . +/// +type Ipv6AddressAttribute + /// + /// Creates the attribute. + /// + () = + inherit GenAttribute() + /// + override _.Generator = + Gen.ipv6Address diff --git a/tests/Hedgehog.MSTest/GenAttribute.fs b/tests/Hedgehog.MSTest/GenAttribute.fs new file mode 100644 index 00000000..d02b87c3 --- /dev/null +++ b/tests/Hedgehog.MSTest/GenAttribute.fs @@ -0,0 +1,74 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/GenAttribute.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/GenAttribute.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the non-generic base GenAttribute is added and +// declares Box, which GenAttribute<'a> overrides; the documentation is rewritten. + +namespace Hedgehog.MSTest + +open System +open Hedgehog +open Hedgehog.FSharp + +/// +/// The non-generic base of . +/// +/// The adapter finds the generator of a parameter through this type, so an attribute derived from another generator +/// attribute, such as one derived from , is found wherever it sits in the +/// inheritance chain. Upstream's adapters check only the direct base type and auto-generate the value of such a +/// parameter without a warning. +/// +/// +[] +[] +type GenAttribute + /// + /// Called by the constructors of derived attributes. + /// + () = + inherit Attribute() + + /// + /// Returns the generator of the parameter with its values boxed. + /// + abstract member Box: unit -> Gen + +/// +/// Sets the generator of one parameter of a method marked with . +/// +/// It wins over the that +/// and name. +/// +/// +/// The type of the parameter. +/// +/// +/// type ConstantInt(i: int) = +/// inherit GenAttribute<int>() +/// override _.Generator = Gen.constant i +/// +/// [<Property>] +/// member _.``is always 2`` ([<ConstantInt(2)>] i) = +/// Assert.AreEqual(2, i, "the attribute sets the value") +/// +/// +[] +[] +type GenAttribute<'a> + /// + /// Called by the constructors of derived attributes. + /// + () = + inherit GenAttribute() + + /// + /// The generator of the parameter. + /// + abstract member Generator: Gen<'a> + + /// + /// Returns with its values boxed. + /// + override this.Box() = this.Generator |> Gen.map box diff --git a/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj b/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj new file mode 100644 index 00000000..91f52050 --- /dev/null +++ b/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj @@ -0,0 +1,55 @@ + + + + + net10.0 + Hedgehog.MSTest + true + disable + + + false + false + true + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/Hedgehog.MSTest/IPropertyAttribute.fs b/tests/Hedgehog.MSTest/IPropertyAttribute.fs new file mode 100644 index 00000000..9879f7f1 --- /dev/null +++ b/tests/Hedgehog.MSTest/IPropertyAttribute.fs @@ -0,0 +1,22 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/IPropertyAttribute.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/IPropertyAttribute.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the Seed setting is added. + +namespace Hedgehog.MSTest + +open System +open Hedgehog + +// Represents the interface for property attributes used in property-based testing. +// This interface is shared between Property and Properties attributes. +[] +type internal IPropertyAttribute = + abstract member AutoGenConfig: Type option with get, set + abstract member AutoGenConfigArgs: obj array with get, set + abstract member Tests: int option with get, set + abstract member Shrinks: int option with get, set + abstract member Size: Size option with get, set + abstract member Seed: uint64 option with get, set diff --git a/tests/Hedgehog.MSTest/InternalLogic.fs b/tests/Hedgehog.MSTest/InternalLogic.fs new file mode 100644 index 00000000..b9fbbf12 --- /dev/null +++ b/tests/Hedgehog.MSTest/InternalLogic.fs @@ -0,0 +1,399 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/InternalLogic.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/InternalLogic.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: +// - the opened namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; +// - MSTest invokes the test method: every case is one call of an invoker such as ITestMethod.InvokeAsync, memoised +// per node of the shrink tree, with the values of an MSTest data row as the leading arguments, and an inconclusive +// result discards the case; this replaces the invocation through reflection and the handling of return values +// (bool, Property, Result, Async, Task<'T>), which MSTest 4 cannot discover; +// - generic methods and return types other than unit, Task and ValueTask are rejected before any generator is built; +// - a GenAttribute is found through its non-generic base, wherever it sits in the inheritance chain; +// - the Seed setting is applied, the run stops without shrinking once the TestContext token is cancelled, and a recheck +// runs on the thread pool; the arguments generated for a case that the cancelled token keeps from running are +// disposed as well; +// - the run is folded into one MSTest TestResult, whose failure message ends with a Recheck attribute to add next to +// the Property attribute, and any exception becomes an error result. + +module internal InternalLogic + +open Hedgehog +open Hedgehog.FSharp +open Hedgehog.MSTest +open Microsoft.VisualStudio.TestTools.UnitTesting +open System +open System.Diagnostics +open System.Reflection +open System.Threading +open System.Threading.Tasks + +// ======================================== +// Type Utilities & Helpers +// ======================================== + +type private TypedReflectionMarker = class end + +[] +let private GenxAutoBoxMethodName = "genxAutoBoxWith" + +let private genxAutoBoxWith<'T> x = x |> Gen.autoWith<'T> |> Gen.map box + +let private genxAutoBoxWithMethodInfo = + typeof.DeclaringType.GetTypeInfo().GetDeclaredMethod(GenxAutoBoxMethodName) + +// ======================================== +// Resource Management +// ======================================== + +let dispose (o: obj) = + match o with + | :? IDisposable as d -> d.Dispose() + | _ -> () + +// ======================================== +// Configuration Helpers +// ======================================== + +let withTests = + function + | Some x -> PropertyConfig.withTests x + | None -> id + +let withShrinks = + function + | Some x -> PropertyConfig.withShrinks x + | None -> id + +let withSeed = + function + | Some x -> PropertyConfig.withSeed (Seed.from x) + | None -> id + +// ======================================== +// Method Validation +// ======================================== + +/// Throws when the method cannot run as a property +let validate (testMethod: MethodInfo) = + // MSTest 4.2.3 discovers a generic test method although TestMethodAttribute documents that it must not be generic; + // upstream closes the method over obj, which turns every generated value into null + if testMethod.ContainsGenericParameters then + invalidOp ( + $"%s{testMethod.Name} is generic, but a property method must not be: Hedgehog cannot generate arguments " + + "for a type parameter. Give every parameter a concrete type." + ) + + // MSTest 4 discovers only methods that return void, Task or ValueTask; any other return type fails the discovery of + // the whole assembly (UTA007), so this guards the runner when it is driven directly + let returnType = testMethod.ReturnType + + if returnType <> typeof && returnType <> typeof && returnType <> typeof then + let advice = + if ReflectionHelpers.isGenericTask returnType || ReflectionHelpers.isGenericValueTask returnType then + "return Task or ValueTask without a result and fail by throwing, such as through an Assert call" + elif ReflectionHelpers.isAsync returnType then + "return a Task from a task { } expression instead of an Async" + elif ReflectionHelpers.isResult returnType then + "fail by throwing, such as through an Assert call, instead of returning Error" + else + "return unit, Task or ValueTask and fail by throwing, such as through an Assert call" + + invalidOp $"%s{testMethod.Name} returns %s{returnType.Name}, which MSTest cannot run as a test method: %s{advice}." + +// ======================================== +// Generator Creation +// ======================================== + +module private GeneratorFactory = + /// Tries to get a custom generator from a GenAttribute on a parameter, whatever its place in the inheritance chain + let tryGetAttributeGenerator (parameterInfo: ParameterInfo) : Gen option = + parameterInfo.GetCustomAttributes() + |> Seq.tryPick (function + | :? GenAttribute as attr -> Some(attr.Box()) + | _ -> None) + + /// Creates a generator for a parameter based on attribute or type + let createGenerator (autoGenConfig: obj) (parameter: ParameterInfo) : Gen = + match tryGetAttributeGenerator parameter with + | Some gen -> gen + | None -> + genxAutoBoxWithMethodInfo.MakeGenericMethod(parameter.ParameterType).Invoke(null, [| autoGenConfig |]) + :?> Gen + + /// Creates a list generator for all test method parameters + let createParameterListGenerator (context: PropertyContext) (parameters: ParameterInfo[]) : Gen = + let gens = + parameters + |> Array.map (createGenerator context.AutoGenConfig) + |> List.ofArray + |> Gen.sequenceList + + match context.Size, context.Recheck with + | _, Some _ -> gens // Size from recheck data if present + | Some size, _ -> gens |> Gen.resize size + | None, _ -> gens + +// ======================================== +// Invocation +// ======================================== + +/// What one run of a property produced, before it becomes an MSTest result +type PropertyRun = + { /// Hedgehog's report of the run + Report: Report + /// The number of invocations of the test method, shrink steps included + Invocations: int + /// The result of the last invocation that failed: with every invocation memoised, that of the counterexample + LastFailure: TestResult voption + /// Whether the run stopped because the TestContext cancellation token was cancelled + Cancelled: bool } + +/// The bookkeeping of one run; Hedgehog evaluates the cases of a run one after another, so it needs no locking +type private RunState() = + member val Invocations = 0 with get, set + member val LastFailure: TestResult voption = ValueNone with get, set + member val Cancelled = false with get, set + +[] +let private TestFailedExceptionTypeName = + "Microsoft.VisualStudio.TestPlatform.MSTest.TestAdapter.ObjectModel.TestFailedException" + +/// The exception of a failed invocation. MSTest wraps what the test method threw into its internal +/// TestFailedException; one without an inner exception, such as a timeout, stands for itself. +let exceptionOf (result: TestResult) : exn = + match result.TestFailureException with + | null -> InvalidOperationException($"The invocation of the test method ended with the outcome %O{result.Outcome}.") + | error when + String.Equals(error.GetType().FullName, TestFailedExceptionTypeName, StringComparison.Ordinal) + && not (isNull error.InnerException) + -> + error.InnerException + | error -> error + +module private PropertyBuilder = + /// Creates a property whose every case invokes the test method once + let createProperty + (state: RunState) + (rechecking: bool) + (cancellationToken: unit -> CancellationToken) + (invoke: obj array -> Task) + (parameters: ParameterInfo[]) + (dataRow: obj array) + (gens: Gen) + : Property = + + let invokeOnce (generated: obj list) : Task> = + task { + // Read before every invocation: MSTest gives the TestContext a new token source before each TestCleanup, + // so the token in effect during this invocation is the one read now, and the one to check after it + let token = cancellationToken () + + if state.Cancelled || token.IsCancellationRequested then + state.Cancelled <- true + // The case does not run, but the arguments generated for it are disposed all the same + List.iter dispose generated + return Journal.singletonMessage "Not run: the TestContext cancellation token is cancelled.", Discard + else + let arguments = Array.append dataRow (Array.ofList generated) + + let! result = + task { + try + try + return! invoke arguments + with e -> + // MSTest reports what the test method throws in the result; an exception comes + // from MSTest itself, so the case fails with it + return TestResult(Outcome = UnitTestOutcome.Error, TestFailureException = e) + finally + List.iter dispose generated + } + + state.Invocations <- state.Invocations + 1 + + match result.Outcome with + | UnitTestOutcome.Passed -> return Journal.empty, Success() + // Assert.Inconclusive marks a case whose precondition does not hold, so Hedgehog discards it. A + // recheck replays a single case and cannot discard it, so there the case fails instead. + | UnitTestOutcome.Inconclusive when not rechecking -> return Journal.empty, Discard + | _ -> + state.LastFailure <- ValueSome result + + // A [] cancels the token of the invocation it applies to. Every shrink step would wait + // for the timeout again, so the run stops and reports this case as it is. + if token.IsCancellationRequested then + state.Cancelled <- true + + return Journal.exn (exceptionOf result), Failure + } + + let createJournal (generated: obj list) = + generated + |> Seq.append dataRow + |> Seq.zip parameters + |> Seq.map (fun (param, value) -> fun () -> TestParameter(param.Name, value)) + |> Array.ofSeq // not sure if journal will do multiple enumerations + |> Journal.ofSeq + + gens + |> Property.bindWith createJournal (fun generated -> + // Hedgehog 2.0.4 runs an asynchronous result again whenever it unwraps it, and it unwraps the final + // counterexample a second time to read its journal. The lazy task makes that one invocation per node of the + // shrink tree: side effects happen once, and the journal is that of the invocation that failed. + let invocation = lazy (invokeOnce generated) + Property.ofAsyncWithJournal (async { return! Async.AwaitTask invocation.Value })) + +// ======================================== +// Report Generation +// ======================================== + +/// Runs the method as a property: Hedgehog generates the arguments that follow the data row, and invoke runs the test +/// method once for every case and every shrink step +let runAsync + (context: PropertyContext) + (testMethod: MethodInfo) + (dataRow: obj array) + (invoke: obj array -> Task) + (cancellationToken: unit -> CancellationToken) + : Task = + task { + let dataRow = + match dataRow with + | null -> [||] + | dataRow -> dataRow + + let parameters = testMethod.GetParameters() + let generatedParameters = parameters |> Array.skip (min dataRow.Length parameters.Length) + let gens = GeneratorFactory.createParameterListGenerator context generatedParameters + let state = RunState() + + let property = + PropertyBuilder.createProperty state context.Recheck.IsSome cancellationToken invoke parameters dataRow gens + + let config = + PropertyConfig.defaults + |> withTests context.Tests + |> withShrinks context.Shrinks + |> withSeed context.Seed + + let! report = + match context.Recheck with + // Hedgehog 2.0.4 rechecks synchronously and blocks on asynchronous results, so the replay runs on the thread + // pool instead of blocking the test thread + | Some recheckData -> Task.Run(fun () -> Property.reportRecheckWith recheckData config property) + | None -> Property.reportTaskWith config property + + return + { Report = report + Invocations = state.Invocations + LastFailure = state.LastFailure + Cancelled = state.Cancelled } + } + +// ======================================== +// MSTest Results +// ======================================== + +let private recheckHint (report: Report) = + match report.Status with + | Failed { RecheckInfo = Some info } -> + let data = RecheckData.serialize info.Data + // Recheck on its own, to be added next to the method's Property attribute: replacing that attribute would drop + // settings such as its AutoGenConfig, and the recheck data would no longer replay this counterexample + $"%s{Environment.NewLine}Reproduce by adding next to the Property attribute: []" + | _ -> "" + +let private failedResult (message: string) (failure: TestResult voption) (summary: string) (duration: TimeSpan) = + match failure with + | ValueSome source -> + TestResult( + Outcome = UnitTestOutcome.Failed, + TestFailureException = AssertFailedException(message, exceptionOf source), + // The output of the invocation that failed, which is the counterexample the message shows + LogOutput = summary + Environment.NewLine + source.LogOutput, + LogError = source.LogError, + DebugTrace = source.DebugTrace, + TestContextMessages = source.TestContextMessages, + ResultFiles = source.ResultFiles, + Duration = duration + ) + | ValueNone -> + TestResult( + Outcome = UnitTestOutcome.Failed, + TestFailureException = AssertFailedException(message), + LogOutput = summary, + Duration = duration + ) + +/// Folds a run into the one MSTest result of the property +let toTestResult (run: PropertyRun) (duration: TimeSpan) : TestResult = + let report = run.Report + + let summary = + $"Hedgehog: %d{int report.Tests} tests, %d{int report.Discards} discards, " + + $"%d{run.Invocations} invocations of the test method." + + if run.Cancelled then + let message = + $"The property stopped after %d{run.Invocations} invocations without shrinking, because the TestContext " + + "cancellation token was cancelled: a [] applies to each invocation, or the test run was cancelled." + + Environment.NewLine + + Report.render report + + recheckHint report + + failedResult message run.LastFailure summary duration + else + match report.Status with + | OK -> TestResult(Outcome = UnitTestOutcome.Passed, LogOutput = summary, Duration = duration) + | GaveUp -> + let message = + Report.render report + + Environment.NewLine + + "Hedgehog gives up after 100 discarded cases; an invocation that calls Assert.Inconclusive is discarded." + + failedResult message ValueNone summary duration + | Failed _ -> failedResult (Report.render report + recheckHint report) run.LastFailure summary duration + +/// The result of a property that could not run +let errorResult (error: exn) (duration: TimeSpan) : TestResult = + let error = + match error with + | :? TargetInvocationException as e when not (isNull e.InnerException) -> e.InnerException + | e -> e + + TestResult( + Outcome = UnitTestOutcome.Error, + TestFailureException = AssertFailedException($"Hedgehog could not run the property: %s{error.Message}", error), + Duration = duration + ) + +/// Runs the method as a property and folds the run into one MSTest result; no exception escapes. This is the entry +/// point of PropertyAttribute.ExecuteAsync, and the adapter's own tests drive it with an invoker of their own. +let executeAsync + (testMethod: MethodInfo) + (dataRow: obj array) + (invoke: obj array -> Task) + (cancellationToken: unit -> CancellationToken) + : Task = + task { + let stopwatch = Stopwatch.StartNew() + + try + validate testMethod + let context = PropertyContext.fromMethod testMethod + let! run = runAsync context testMethod dataRow invoke cancellationToken + return toTestResult run stopwatch.Elapsed + with error -> + return errorResult error stopwatch.Elapsed + } + +/// The cancellation token of the current invocation. TestContext.Current is the only way from an attribute to the +/// TestContext, and MSTest 4.2.3 and 4.3.2 mark it experimental (MSTESTEXP), so FS0057 is suppressed here only. +let currentCancellationToken () : CancellationToken = +#nowarn "57" + match TestContext.Current with + | null -> CancellationToken.None + | context -> context.CancellationToken +#warnon "57" diff --git a/tests/Hedgehog.MSTest/Prelude.fs b/tests/Hedgehog.MSTest/Prelude.fs new file mode 100644 index 00000000..a06756cf --- /dev/null +++ b/tests/Hedgehog.MSTest/Prelude.fs @@ -0,0 +1,43 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/Prelude.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/Prelude.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest. + +[] +module internal Hedgehog.MSTest.Prelude + +open System + +module Option = + let requireSome msg = + function + | Some x -> x + | None -> failwith msg + +module Seq = + // https://github.com/dotnet/fsharp/blob/b9942004e8ba19bf73862b69b2d71151a98975ba/src/FSharp.Core/seqcore.fs#L172-L174 + let inline private checkNonNull argName arg = + if isNull arg then nullArg argName + + // https://github.com/dotnet/fsharp/blob/b9942004e8ba19bf73862b69b2d71151a98975ba/src/FSharp.Core/seq.fs#L1710-L1719 + let seqTryExactlyOne (source: seq<_>) = + checkNonNull "source" source + use e = source.GetEnumerator() + + if e.MoveNext() then + let v = e.Current + if e.MoveNext() then None else Some v + else + None + +module internal Type = + let getAllAttributes<'T> (t: Type) : 'T list = + t + |> Seq.unfold (fun ty -> if ty = null then None else Some(ty, ty.BaseType)) + |> Seq.choose (fun ty -> + ty.GetCustomAttributes(false) + |> Seq.tryFind (fun attr -> attr :? 'T) + |> Option.map (fun attr -> attr :?> 'T)) + |> Seq.toList diff --git a/tests/Hedgehog.MSTest/PropertiesAttribute.fs b/tests/Hedgehog.MSTest/PropertiesAttribute.fs new file mode 100644 index 00000000..16587c48 --- /dev/null +++ b/tests/Hedgehog.MSTest/PropertiesAttribute.fs @@ -0,0 +1,119 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/PropertiesAttribute.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/PropertiesAttribute.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the Seed setting is added; the primary +// constructor, whose option parameters an attribute cannot take, is private, as in PropertyAttribute; the documentation +// is rewritten. + +namespace Hedgehog.MSTest + +open System +open Hedgehog + +/// +/// Sets the defaults of every method of a test class. +/// +/// The settings come from the class that MSTest runs, so a property inherited from an abstract base class gets the +/// settings of each derived test class. Along the inheritance chain the settings of a derived class win over those of +/// its base classes, and the configurations are merged in the same order; a +/// setting of wins over all of them. +/// +/// +[] +type PropertiesAttribute private (autoGenConfig, autoGenConfigArgs, tests, shrinks, size) = + inherit Attribute() + + let mutable _autoGenConfig: Type option = autoGenConfig + let mutable _autoGenConfigArgs: obj[] = autoGenConfigArgs + let mutable _tests: int option = tests + let mutable _shrinks: int option = shrinks + let mutable _size: Size option = size + let mutable _seed: uint64 option = None + + /// + /// A type with exactly one public static member that returns , optionally + /// taking . Only for setting: reading it throws. + /// + member _.AutoGenConfig with set v = _autoGenConfig <- Some v and get ():Type = failwith "this getter only exists to make C# named arguments work" + + /// + /// The arguments of the member of . Only for + /// setting: reading it throws. + /// + member _.AutoGenConfigArgs with set v = _autoGenConfigArgs <- v and get ():obj array = failwith "this getter only exists to make C# named arguments work" + + /// + /// The number of cases that must pass. Only for setting: reading it throws. + /// + member _.Tests with set v = _tests <- Some v and get ():int = failwith "this getter only exists to make C# named arguments work" + + /// + /// The largest number of shrink steps of a failure. Only for setting: reading it throws. + /// + member _.Shrinks with set v = _shrinks <- Some v and get ():int = failwith "this getter only exists to make C# named arguments work" + + /// + /// The size of every generated case. Only for setting: reading it throws. + /// + member _.Size with set v = _size <- Some v and get ():Size = failwith "this getter only exists to make C# named arguments work" + + /// + /// The seed of every run, such as one seed per suite. Only for setting: reading it throws. + /// + member _.Seed with set v = _seed <- Some v and get ():uint64 = failwith "this getter only exists to make C# named arguments work" + + /// + /// Sets no defaults; named arguments set them. + /// + new() = PropertiesAttribute(None , [||], None , None , None) + + /// + /// Sets the number of cases that must pass. + /// + /// The number of cases that must pass. + new(tests) = PropertiesAttribute(None , [||], Some tests, None , None) + + /// + /// Sets the number of cases that must pass and the largest number of shrink steps. + /// + /// The number of cases that must pass. + /// The largest number of shrink steps. + new(tests, shrinks) = PropertiesAttribute(None , [||], Some tests, Some shrinks, None) + + /// + /// Sets the configuration of the generated arguments. + /// + /// + /// A type with exactly one public static member that returns . + /// + new(autoGenConfig) = PropertiesAttribute(Some autoGenConfig, [||], None , None , None) + + /// + /// Sets the configuration of the generated arguments and the number of cases that must pass. + /// + /// + /// A type with exactly one public static member that returns . + /// + /// The number of cases that must pass. + new(autoGenConfig:Type, tests) = PropertiesAttribute(Some autoGenConfig, [||], Some tests, None , None) + + /// + /// Sets the configuration of the generated arguments, the number of cases that must pass and the largest number of + /// shrink steps. + /// + /// + /// A type with exactly one public static member that returns . + /// + /// The number of cases that must pass. + /// The largest number of shrink steps. + new(autoGenConfig:Type, tests, shrinks) = PropertiesAttribute(Some autoGenConfig, [||], Some tests, Some shrinks, None) + + interface IPropertyAttribute with + member _.AutoGenConfig with get () = _autoGenConfig and set v = _autoGenConfig <- v + member _.AutoGenConfigArgs with get () = _autoGenConfigArgs and set v = _autoGenConfigArgs <- v + member _.Tests with get () = _tests and set v = _tests <- v + member _.Shrinks with get () = _shrinks and set v = _shrinks <- v + member _.Size with get () = _size and set v = _size <- v + member _.Seed with get () = _seed and set v = _seed <- v diff --git a/tests/Hedgehog.MSTest/PropertyAttribute.fs b/tests/Hedgehog.MSTest/PropertyAttribute.fs new file mode 100644 index 00000000..c4fa9156 --- /dev/null +++ b/tests/Hedgehog.MSTest/PropertyAttribute.fs @@ -0,0 +1,225 @@ +// Based on src/Hedgehog.NUnit/PropertyAttribute.fs of hedgehogqa/fsharp-hedgehog at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/PropertyAttribute.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the settings, their C#-friendly getters and the six constructor overloads are upstream's; the attribute +// derives from MSTest's TestMethodAttribute instead of NUnit's TestAttribute and, like it, applies to methods only and is +// not inherited; every constructor forwards the caller information to it, the primary constructor is private, the Seed +// setting is added, and an override of TestMethodAttribute.ExecuteAsync replaces the NUnit test builder and test +// method; the documentation is rewritten. + +namespace Hedgehog.MSTest + +open System +open System.Runtime.CompilerServices +open System.Runtime.InteropServices +open System.Threading.Tasks +open Hedgehog +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// +/// Marks an MSTest test method as a Hedgehog property: Hedgehog generates its arguments, MSTest invokes it once for +/// every generated case and every shrink step, and the property reports a single +/// . +/// +/// A parameter gets its value from the on it or, without one, from +/// with the +/// of this attribute merged over those of the +/// of the test class and its base classes. The values of a +/// or +/// row are the leading arguments, and +/// only the parameters after them are generated. A setting of this attribute wins over the same setting of +/// , and replays a +/// reported failure. +/// +/// +/// The method is a non-generic instance member that returns , +/// or and fails by +/// throwing, such as through an call; MSTest does not +/// discover a test method that returns anything else. MSTest creates the test class, injects its +/// and runs its +/// and +/// methods for every invocation, and a +/// applies to each invocation. A generated +/// argument that is is disposed after its invocation. +/// +/// +/// An invocation that calls +/// is discarded, and the property fails when Hedgehog gives up after 100 discarded cases. A failed property reports +/// Hedgehog's report with the shrunk arguments, the exception of the counterexample as inner exception, the output of its +/// invocation and a ready to paste. Once the cancellation token of the +/// is cancelled, by a timeout or by the test +/// run, the property stops without shrinking. +/// +/// +/// +/// +/// [<TestClass>] +/// type ReverseTests () = +/// +/// [<Property(200<tests>)>] +/// member _.``reversing a list twice gives the list back`` (xs : int list) = +/// Assert.AreEqual (xs, List.rev (List.rev xs), "reversing twice must give the list back") +/// +/// +[] +type PropertyAttribute + private + ( + autoGenConfig: Type option, + autoGenConfigArgs: obj[], + tests: int option, + shrinks: int option, + size: Size option, + callerFilePath: string, + callerLineNumber: int + ) = + // TestMethodAttribute records the declaring file and line of the test method from the caller information of its + // constructor, as STATestMethodAttribute passes it on; F# fills it in for attribute constructors too + inherit TestMethodAttribute(callerFilePath, callerLineNumber) + + let mutable _autoGenConfig: Type option = autoGenConfig + let mutable _autoGenConfigArgs: obj[] = autoGenConfigArgs + let mutable _tests: int option = tests + let mutable _shrinks: int option = shrinks + let mutable _size: Size option = size + let mutable _seed: uint64 option = None + + /// + /// A type with exactly one public static member that returns , optionally + /// taking ; its configuration is merged over that of + /// . Only for setting: reading it throws. + /// + member _.AutoGenConfig with set v = _autoGenConfig <- Some v and get ():Type = failwith "this getter only exists to make C# named arguments work" + + /// + /// The arguments of the member of . Only for setting: + /// reading it throws. + /// + member _.AutoGenConfigArgs with set v = _autoGenConfigArgs <- v and get ():obj array = failwith "this getter only exists to make C# named arguments work" + + /// + /// The number of cases that must pass, 100 unless set here or on . + /// Only for setting: reading it throws. + /// + member _.Tests with set v = _tests <- Some v and get ():int = failwith "this getter only exists to make C# named arguments work" + + /// + /// The largest number of shrink steps of a failure, unlimited unless set here or on + /// . Only for setting: reading it throws. + /// + member _.Shrinks with set v = _shrinks <- Some v and get ():int = failwith "this getter only exists to make C# named arguments work" + + /// + /// The size of every generated case; without it the size grows from case to case. Only for setting: reading it + /// throws. + /// + member _.Size with set v = _size <- Some v and get ():Size = failwith "this getter only exists to make C# named arguments work" + + /// + /// The seed of the run, so that every run generates the same cases; without it every run draws a random seed. + /// Only for setting: reading it throws. + /// + member _.Seed with set v = _seed <- Some v and get ():uint64 = failwith "this getter only exists to make C# named arguments work" + + /// + /// Runs the property with the settings of or Hedgehog's + /// defaults. + /// + /// The file that declares the test method; the compiler fills it in. + /// The line that declares the test method; the compiler fills it in. + new([] callerFilePath: string, [] callerLineNumber: int) = + PropertyAttribute(None, [||], None, None, None, callerFilePath, callerLineNumber) + + /// + /// Runs the property until cases pass. + /// + /// The number of cases that must pass. + /// The file that declares the test method; the compiler fills it in. + /// The line that declares the test method; the compiler fills it in. + new(tests, [] callerFilePath: string, [] callerLineNumber: int) = + PropertyAttribute(None, [||], Some tests, None, None, callerFilePath, callerLineNumber) + + /// + /// Runs the property until cases pass and shrinks a failure in at most + /// steps. + /// + /// The number of cases that must pass. + /// The largest number of shrink steps. + /// The file that declares the test method; the compiler fills it in. + /// The line that declares the test method; the compiler fills it in. + new(tests, shrinks, [] callerFilePath: string, [] callerLineNumber: int) = + PropertyAttribute(None, [||], Some tests, Some shrinks, None, callerFilePath, callerLineNumber) + + /// + /// Generates the arguments with the configuration of . + /// + /// + /// A type with exactly one public static member that returns . + /// + /// The file that declares the test method; the compiler fills it in. + /// The line that declares the test method; the compiler fills it in. + new(autoGenConfig, [] callerFilePath: string, [] callerLineNumber: int) = + PropertyAttribute(Some autoGenConfig, [||], None, None, None, callerFilePath, callerLineNumber) + + /// + /// Generates the arguments with the configuration of until + /// cases pass. + /// + /// + /// A type with exactly one public static member that returns . + /// + /// The number of cases that must pass. + /// The file that declares the test method; the compiler fills it in. + /// The line that declares the test method; the compiler fills it in. + new(autoGenConfig:Type, tests, [] callerFilePath: string, [] callerLineNumber: int) = + PropertyAttribute(Some autoGenConfig, [||], Some tests, None, None, callerFilePath, callerLineNumber) + + /// + /// Generates the arguments with the configuration of until + /// cases pass and shrinks a failure in at most steps. + /// + /// + /// A type with exactly one public static member that returns . + /// + /// The number of cases that must pass. + /// The largest number of shrink steps. + /// The file that declares the test method; the compiler fills it in. + /// The line that declares the test method; the compiler fills it in. + new(autoGenConfig:Type, tests, shrinks, [] callerFilePath: string, [] callerLineNumber: int) = + PropertyAttribute(Some autoGenConfig, [||], Some tests, Some shrinks, None, callerFilePath, callerLineNumber) + + interface IPropertyAttribute with + member _.AutoGenConfig with get () = _autoGenConfig and set v = _autoGenConfig <- v + member _.AutoGenConfigArgs with get () = _autoGenConfigArgs and set v = _autoGenConfigArgs <- v + member _.Tests with get () = _tests and set v = _tests <- v + member _.Shrinks with get () = _shrinks and set v = _shrinks <- v + member _.Size with get () = _size and set v = _size <- v + member _.Seed with get () = _seed and set v = _seed <- v + + /// + /// Runs the test method as a property instead of invoking it once, and returns the single result of the property. + /// + /// Each case is one call of + /// with the values of the data row in + /// followed by the generated ones. A property that cannot run, because the method is generic or returns a type MSTest + /// cannot run, because an type is invalid or the recheck data cannot be read, + /// gives a result with the outcome + /// instead of an exception. + /// + /// + /// The test method that MSTest runs. + /// An array with the one result of the property. + override _.ExecuteAsync(testMethod: ITestMethod) : Task = + task { + let! result = + InternalLogic.executeAsync + testMethod.MethodInfo + testMethod.Arguments + (fun arguments -> testMethod.InvokeAsync arguments) + InternalLogic.currentCancellationToken + + // Several results from one ExecuteAsync call appear as separate results of one test and inflate the totals + return [| result |] + } diff --git a/tests/Hedgehog.MSTest/PropertyContext.fs b/tests/Hedgehog.MSTest/PropertyContext.fs new file mode 100644 index 00000000..d228ee61 --- /dev/null +++ b/tests/Hedgehog.MSTest/PropertyContext.fs @@ -0,0 +1,71 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/PropertyContext.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/PropertyContext.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the Seed setting is added; class-level settings +// are read from the reflected type of the method instead of its declaring type, and a derived class's settings win over +// its base class's. + +namespace Hedgehog.MSTest + +open System.Reflection +open Hedgehog +open Hedgehog.FSharp + +/// Represents the context for property-based testing, including configuration and test parameters. +type internal PropertyContext = + { AutoGenConfig: IAutoGenConfig + Tests: int option + Shrinks: int option + Size: Size option + Seed: uint64 option + Recheck: string option } + +module internal PropertyContext = + let defaults: PropertyContext = + { AutoGenConfig = AutoGenConfig.defaults + Tests = None + Shrinks = None + Size = None + Seed = None + Recheck = None } + + let private append (ctx: PropertyContext) (attr: IPropertyAttribute) : PropertyContext = + let config = + match attr.AutoGenConfig with + | Some t -> + AutoGenConfig.instantiate t attr.AutoGenConfigArgs + |> AutoGenConfig.merge ctx.AutoGenConfig + | None -> ctx.AutoGenConfig + + { ctx with + AutoGenConfig = config + Tests = attr.Tests |> Option.orElse ctx.Tests + Shrinks = attr.Shrinks |> Option.orElse ctx.Shrinks + Size = attr.Size |> Option.orElse ctx.Size + Seed = attr.Seed |> Option.orElse ctx.Seed } + + let fromMethod (method: MethodInfo) = + let propertyAttribute = + method.GetCustomAttributes() + |> Seq.cast + |> Seq.filter (fun attr -> attr :? IPropertyAttribute) + |> Seq.exactlyOne + :?> IPropertyAttribute + + // MSTest runs a property inherited from an abstract base class once per derived test class: the class it runs is + // the reflected type of the method, while the declaring type is the base class. Type.getAllAttributes lists a + // class before its base classes; reversed, the settings of a derived class are applied last and win. + let classAttributes = + method.ReflectedType |> Type.getAllAttributes |> List.rev + + let context = + [ propertyAttribute ] |> Seq.append classAttributes |> Seq.fold append defaults + + let recheckData = + method.GetCustomAttributes(typeof) + |> Seq.tryHead + |> Option.map (fun x -> (x :?> RecheckAttribute).GetRecheckData) + + { context with Recheck = recheckData } diff --git a/tests/Hedgehog.MSTest/RecheckAttribute.fs b/tests/Hedgehog.MSTest/RecheckAttribute.fs new file mode 100644 index 00000000..d00c5de7 --- /dev/null +++ b/tests/Hedgehog.MSTest/RecheckAttribute.fs @@ -0,0 +1,33 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/RecheckAttribute.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/RecheckAttribute.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the documentation is rewritten. + +namespace Hedgehog.MSTest + +open System + +/// +/// Replays the counterexample of a failed run of the property instead of generating new cases. +/// +/// A failed property reports its recheck data, the size, the seed and the shrink path of the counterexample, together +/// with this attribute ready to paste. The replay runs exactly one case, at the recorded size and seed, so it overrides +/// and . +/// An in the replayed case fails it, +/// because a replay cannot discard its only case, and recheck data that cannot be read gives an error result. +/// +/// +[] +type RecheckAttribute + /// + /// Replays the counterexample that describes. + /// + /// The recheck data that the failed run reported. + (recheckData) = + inherit Attribute() + + let _recheckData: string = recheckData + + member internal _.GetRecheckData = _recheckData diff --git a/tests/Hedgehog.MSTest/ReflectionHelpers.fs b/tests/Hedgehog.MSTest/ReflectionHelpers.fs new file mode 100644 index 00000000..95995a02 --- /dev/null +++ b/tests/Hedgehog.MSTest/ReflectionHelpers.fs @@ -0,0 +1,29 @@ +// Copied from hedgehogqa/fsharp-hedgehog, src/Hedgehog.NUnit/ReflectionHelpers.fs at the Hedgehog 2.0.4 release commit +// a46977278db9a60542e3df3fe0fcd74b90f38ee3: +// https://github.com/hedgehogqa/fsharp-hedgehog/blob/a46977278db9a60542e3df3fe0fcd74b90f38ee3/src/Hedgehog.NUnit/ReflectionHelpers.fs +// Copyright (c) 2016 Jacob Stanley, Nikos Baxevanis. Licensed under the Apache License, Version 2.0 +// (http://www.apache.org/licenses/LICENSE-2.0); see THIRD-PARTY-NOTICES.md at the root of this repository. +// Changes: the method invocation helpers are removed, because MSTest invokes the test method and awaits its result; +// the type checks remain and name the return types that MSTest cannot run. + +/// Reflection utilities for type checking +module internal ReflectionHelpers + +open System +open System.Threading.Tasks + +// ======================================== +// Type Checking +// ======================================== + +let isGenericTask (t: Type) = + t.IsGenericType && typeof.IsAssignableFrom(t) + +let isGenericValueTask (t: Type) = + t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> + +let isAsync (t: Type) = + t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> + +let isResult (t: Type) = + t.IsGenericType && t.GetGenericTypeDefinition() = typedefof>