From 60706598b8b1bc08abaf78a87cd0ca5314a882fb Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 3 Oct 2026 03:32:17 +0200 Subject: [PATCH 1/8] test: port the framework-neutral Hedgehog adapter sources Start the Hedgehog MSTest adapter, tests/Hedgehog.MSTest (ADR 0001, sections 5, 14 and 22.6), with the nine files that Hedgehog.NUnit and Hedgehog.Xunit of hedgehogqa/fsharp-hedgehog share and that do not depend on a test framework: Prelude, ReflectionHelpers, AutoGenConfig, IPropertyAttribute, RecheckAttribute, GenAttribute, GenAttribute.Prelude, PropertyContext and InternalLogic, copied from src/Hedgehog.NUnit at the Hedgehog 2.0.4 release commit a469772 in upstream's file layout and compile order. The only change is the namespace, Hedgehog.NUnit becomes Hedgehog.MSTest, so this commit can be compared with upstream line by line; the MSTest attribute and the changes it needs follow separately. The code is Apache-2.0: every copied file names its origin, the copyright and the license in a header comment, and the new THIRD-PARTY-NOTICES.md records the source, the commit, the files and the license text. The same code is proposed upstream as src/Hedgehog.MSTest, so the project keeps upstream's conventions rather than the repository's: nullness checking is off (upstream enables it nowhere, and the copied files give 23 nullness warnings under the repository's Nullable=enable) and .fantomasignore excludes the project, so the Fantomas run of the build leaves upstream's formatting alone. It sets IsTestProject=false and IsPackable=false, because tests/Directory.Build.props marks every project under tests/ as a test project, references MSTest.TestFramework rather than the MSTest metapackage, and is excluded from the test infrastructure reference of tests/Directory.Build.props, because the adapter must not depend on this repository. The copied code calls functions of FSharp.Core that return an option, such as Seq.tryHead and Seq.tryFind. The collection helpers that the root Directory.Build.props compiles into every F# project replace exactly these functions with ones that return a voption, so the project removes that file from its compilation for now; the commit that moves the adapter to the repository's conventions takes the removal out. The project joins both FSharp.Azure.Cosmos.slnx and FSharp.Azure.Cosmos.slnf, which FAKE builds, so every build compiles it, and THIRD-PARTY-NOTICES.md joins the solution items. Directory.Packages.props gets Hedgehog 2.0.4 (Apache-2.0; FSharp.Core >= 8.0.403 and TypeShape 9.0.0 transitively, checked in the nuspec), which contains the former Hedgehog.Experimental auto-generation. Co-Authored-By: Claude Opus 5.5 --- .fantomasignore | 3 + Directory.Packages.props | 1 + FSharp.Azure.Cosmos.slnf | 3 +- FSharp.Azure.Cosmos.slnx | 2 + THIRD-PARTY-NOTICES.md | 30 ++ tests/Directory.Build.props | 8 +- tests/Hedgehog.MSTest/AutoGenConfig.fs | 41 +++ tests/Hedgehog.MSTest/GenAttribute.Prelude.fs | 188 +++++++++++++ tests/Hedgehog.MSTest/GenAttribute.fs | 35 +++ tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj | 52 ++++ tests/Hedgehog.MSTest/IPropertyAttribute.fs | 21 ++ tests/Hedgehog.MSTest/InternalLogic.fs | 259 ++++++++++++++++++ tests/Hedgehog.MSTest/Prelude.fs | 43 +++ tests/Hedgehog.MSTest/PropertyContext.fs | 63 +++++ tests/Hedgehog.MSTest/RecheckAttribute.fs | 19 ++ tests/Hedgehog.MSTest/ReflectionHelpers.fs | 50 ++++ 16 files changed, 814 insertions(+), 4 deletions(-) create mode 100644 THIRD-PARTY-NOTICES.md create mode 100644 tests/Hedgehog.MSTest/AutoGenConfig.fs create mode 100644 tests/Hedgehog.MSTest/GenAttribute.Prelude.fs create mode 100644 tests/Hedgehog.MSTest/GenAttribute.fs create mode 100644 tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj create mode 100644 tests/Hedgehog.MSTest/IPropertyAttribute.fs create mode 100644 tests/Hedgehog.MSTest/InternalLogic.fs create mode 100644 tests/Hedgehog.MSTest/Prelude.fs create mode 100644 tests/Hedgehog.MSTest/PropertyContext.fs create mode 100644 tests/Hedgehog.MSTest/RecheckAttribute.fs create mode 100644 tests/Hedgehog.MSTest/ReflectionHelpers.fs diff --git a/.fantomasignore b/.fantomasignore index d9f2aa7f..cadd6707 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -1,2 +1,5 @@ # Ignore AssemblyInfo files AssemblyInfo.fs + +# The Hedgehog MSTest adapter follows the conventions of hedgehogqa/fsharp-hedgehog, where the same code is proposed +tests/Hedgehog.MSTest/ 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..7979d6ad 100644 --- a/FSharp.Azure.Cosmos.slnf +++ b/FSharp.Azure.Cosmos.slnf @@ -4,7 +4,8 @@ "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" ] } } \ No newline at end of file diff --git a/FSharp.Azure.Cosmos.slnx b/FSharp.Azure.Cosmos.slnx index 4ec89bbd..ee33a31b 100644 --- a/FSharp.Azure.Cosmos.slnx +++ b/FSharp.Azure.Cosmos.slnx @@ -8,9 +8,11 @@ + + diff --git a/THIRD-PARTY-NOTICES.md b/THIRD-PARTY-NOTICES.md new file mode 100644 index 00000000..d9c424dc --- /dev/null +++ b/THIRD-PARTY-NOTICES.md @@ -0,0 +1,30 @@ +# 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` and `InternalLogic.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/tests/Directory.Build.props b/tests/Directory.Build.props index 73f3282a..71534e42 100644 --- a/tests/Directory.Build.props +++ b/tests/Directory.Build.props @@ -6,10 +6,12 @@ - + diff --git a/tests/Hedgehog.MSTest/AutoGenConfig.fs b/tests/Hedgehog.MSTest/AutoGenConfig.fs new file mode 100644 index 00000000..c84c6387 --- /dev/null +++ b/tests/Hedgehog.MSTest/AutoGenConfig.fs @@ -0,0 +1,41 @@ +// 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. + +namespace Hedgehog.MSTest + +open System +open Hedgehog + +module internal AutoGenConfig = + 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.GetParameters() + |> Array.map _.ParameterType.IsGenericParameter + |> Array.zip configArgs + |> Array.filter snd + |> Array.map (fun (arg, _) -> arg.GetType()) + |> fun argTypes -> methodInfo.MakeGenericMethod argTypes + 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..6ecbbe8e --- /dev/null +++ b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs @@ -0,0 +1,188 @@ +// 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. + +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 integer within a specified range. +/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). +type IntAttribute(min: int, max: int) = + inherit GenAttribute() + /// Generates an integer from Int32.MinValue to Int32.MaxValue. + /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + new() = IntAttribute(Int32.MinValue, Int32.MaxValue) + override _.Generator = + Gen.int32 (chooseRangeInt32 min max) + +/// Generates an odd integer. +/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). +type OddAttribute(min: int, max: int) = + inherit GenAttribute() + /// Generates an odd integer from Int32.MinValue to Int32.MaxValue. + /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + new() = OddAttribute(Int32.MinValue, Int32.MaxValue) + override _.Generator = gen { + let! n = Gen.int32 (chooseRangeInt32 min max) + return n ||| 1 + } + +/// Generates an even integer. +/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). +type EvenAttribute(min: int, max: int) = + inherit GenAttribute() + /// Generates an even integer from Int32.MinValue to Int32.MaxValue. + /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + new() = EvenAttribute(Int32.MinValue, Int32.MaxValue) + override _.Generator = gen { + let! n = Gen.int32 (chooseRangeInt32 min max) + return n &&& ~~~1 + } + +/// Generates a positive integer. +/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). +type PositiveIntAttribute(max: int) = + inherit GenAttribute() + /// Generates a positive integer from 1 to Int32.MaxValue. + /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + new() = PositiveIntAttribute(Int32.MaxValue) + override _.Generator = + Gen.int32 (chooseRangeInt32 1 max) + +/// Generates a non-negative integer. +/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). +type NonNegativeIntAttribute(max: int) = + inherit GenAttribute() + /// Generates a non-negative integer from 0 to Int32.MaxValue. + /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + new() = NonNegativeIntAttribute(Int32.MaxValue) + override _.Generator = + Gen.int32 (chooseRangeInt32 0 max) + +/// Generates a non-zero integer. +/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). +type NonZeroIntAttribute(min: int, max: int) = + inherit GenAttribute() + /// Generates a non-zero integer from Int32.MinValue+1 to Int32.MaxValue. + /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + new() = NonZeroIntAttribute(Int32.MinValue + 1, Int32.MaxValue) + override _.Generator = + match min, max with + | _, m when m < 0 -> Gen.int32 (chooseRangeInt32 min max) // Range entirely negative + | n, _ when n > 0 -> Gen.int32 (chooseRangeInt32 min max) // Range entirely positive + | n, m -> // 0 is in range, split it + Gen.choice [ + Gen.int32 (chooseRangeInt32 n -1) + Gen.int32 (chooseRangeInt32 1 m) + ] + +/// Generates a string that is a valid identifier. +type IdentifierAttribute(maxLen: int) = + inherit GenAttribute() + new() = IdentifierAttribute(25) + override _.Generator = + Gen.identifier maxLen + +/// Generates a string representing a Latin name. +type LatinNameAttribute(maxLength: int) = + inherit GenAttribute() + new() = LatinNameAttribute(20) + override _.Generator = + Gen.latinName maxLength + +/// Generates a string in snake_case. +type SnakeCaseAttribute(maxWordLength: int, maxWordsCount: int) = + inherit GenAttribute() + new() = SnakeCaseAttribute(5, 5) + override _.Generator = + Gen.snakeCase (Range.constant 1 maxWordLength) (Range.constant 1 maxWordsCount) + +/// Generates a string in kebab-case. +type KebabCaseAttribute(maxWordLength: int, maxWordsCount: int) = + inherit GenAttribute() + new() = KebabCaseAttribute(5, 5) + override _.Generator = + Gen.kebabCase (Range.constant 1 maxWordLength) (Range.constant 1 maxWordsCount) + +/// Generates a valid domain name. +type DomainNameAttribute() = + inherit GenAttribute() + override _.Generator = + Gen.domainName + +/// Generates a valid email address. +type EmailAttribute() = + inherit GenAttribute() + override _.Generator = + Gen.email + +/// Generates a DateTime value. +type DateTimeAttribute(kind: DateTimeKind, from: DateTime, duration: TimeSpan) = + inherit GenAttribute() + new() = DateTimeAttribute(DateTimeKind.Utc, DateTime(2000, 1, 1), TimeSpan.FromDays(3650)) + new(from, duration) = DateTimeAttribute(DateTimeKind.Utc, from, duration) + 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 DateTimeOffset value. +type DateTimeOffsetAttribute(from: DateTimeOffset, duration: TimeSpan) = + inherit GenAttribute() + new() = DateTimeOffsetAttribute(DateTimeOffset(2000, 1, 1, 0, 0, 0, TimeSpan.Zero), TimeSpan.FromDays(3650)) + new(from) = DateTimeOffsetAttribute(from, TimeSpan.FromDays(3650)) + override _.Generator = + Gen.dateTimeOffset (Range.constant from (from + duration)) + +/// Generates a string containing alphanumeric characters. +type AlphaNumStringAttribute(minLength: int, maxLength: int) = + inherit GenAttribute() + new() = AlphaNumStringAttribute(0, 256) + new(minLength) = AlphaNumStringAttribute(minLength, 256) + override _.Generator = + Gen.string (Range.constant minLength maxLength) Gen.alphaNum + +/// Generates a string containing unicode characters. +type UnicodeStringAttribute(minLength: int, maxLength: int) = + inherit GenAttribute() + new() = UnicodeStringAttribute(0, 256) + new(minLength) = UnicodeStringAttribute(minLength, 256) + override _.Generator = + Gen.string (Range.constant minLength maxLength) Gen.unicode + +/// Generates an IP address (IPv4). +type Ipv4AddressAttribute() = + inherit GenAttribute() + override _.Generator = + Gen.ipv4Address + +/// Generates an IPv6 address. +type Ipv6AddressAttribute() = + 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..2e8e96e8 --- /dev/null +++ b/tests/Hedgehog.MSTest/GenAttribute.fs @@ -0,0 +1,35 @@ +// 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. + +namespace Hedgehog.MSTest + +open System +open Hedgehog +open Hedgehog.FSharp + +/// Set a Generator for a parameter of a test annotated with `Property` +/// +/// Example usage: +/// +/// ``` +/// +/// type ConstantInt(i: int) = +/// inherit GenAttribute() +/// override _.Generator = Gen.constant i +/// +/// [] +/// let ``is always 2`` ([] i) = +/// Assert.AreEqual(2, i) +/// +/// ``` +[] +[] +type GenAttribute<'a>() = + inherit Attribute() + + abstract member Generator: Gen<'a> + member 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..ac43d103 --- /dev/null +++ b/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj @@ -0,0 +1,52 @@ + + + + + net10.0 + Hedgehog.MSTest + true + disable + + + false + false + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/Hedgehog.MSTest/IPropertyAttribute.fs b/tests/Hedgehog.MSTest/IPropertyAttribute.fs new file mode 100644 index 00000000..09017646 --- /dev/null +++ b/tests/Hedgehog.MSTest/IPropertyAttribute.fs @@ -0,0 +1,21 @@ +// 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. + +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 diff --git a/tests/Hedgehog.MSTest/InternalLogic.fs b/tests/Hedgehog.MSTest/InternalLogic.fs new file mode 100644 index 00000000..7cb6b989 --- /dev/null +++ b/tests/Hedgehog.MSTest/InternalLogic.fs @@ -0,0 +1,259 @@ +// 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. + +module internal InternalLogic + +open Hedgehog +open Hedgehog.FSharp +open Hedgehog.MSTest +open System +open System.Reflection +open System.Threading.Tasks + +// ======================================== +// Type Utilities & Helpers +// ======================================== + +type private TypedReflectionMarker = class end + +[] +let private GenxAutoBoxMethodName = "genxAutoBoxWith" + +[] +let private AssertResultOkMethodName = "assertResultOk" + +[] +let private ConvertAsyncToObjMethodName = "convertAsyncToObj" + +let private convertAsyncToObj<'T> (a: Async<'T>) : Async = + async { + let! x = a + return box x + } + +let private genxAutoBoxWith<'T> x = x |> Gen.autoWith<'T> |> Gen.map box + +let private genxAutoBoxWithMethodInfo = + typeof.DeclaringType.GetTypeInfo().GetDeclaredMethod(GenxAutoBoxMethodName) + +let private convertAsyncToObjMethodInfo = + typeof.DeclaringType.GetTypeInfo().GetDeclaredMethod(ConvertAsyncToObjMethodName) + +// ======================================== +// Result Validation +// ======================================== + +let assertResultOk r = + match r with + | Ok _ -> () + | Error e -> failwithf $"Result is in the Error case with the following value:%s{Environment.NewLine}%A{e}" + +// ======================================== +// Return Value Processing +// ======================================== + +let private toAsyncObj (asyncVal: obj) (t: Type) : Async = + convertAsyncToObjMethodInfo.MakeGenericMethod(t).Invoke(null, [| asyncVal |]) + |> unbox> + +/// Wraps a test method return value into a Property, handling async/task natively +let rec wrapReturnValue (x: obj) : Property = + match x with + | null -> Property.success () + | :? bool as b -> Property.ofBool b + | :? Property as p -> p + | :? Property as p -> p |> Property.falseToFailure + + // Non-generic Task + | :? Task as t when not (t.GetType().IsGenericType) -> Property.ofTaskUnit t + + // Non-generic ValueTask + | :? ValueTask as vt -> vt.AsTask() |> Property.ofTaskUnit + + // Async - common case, avoid reflection + | :? Async as a -> Property.ofAsync a |> Property.map (fun _ -> ()) + + // Generic types requiring reflection + | x -> + let t = x.GetType() + + match t with + | t when ReflectionHelpers.isGenericTask t -> + let taskResultType = t.GetGenericArguments()[0] + let asyncVal = ReflectionHelpers.invokeAwaitTask x + // Use toAsyncObj to avoid InvalidCastException, then wrap in Property + let asyncObj = toAsyncObj asyncVal taskResultType + Property.ofAsync asyncObj |> Property.map wrapReturnValue |> Property.bind id + + | t when ReflectionHelpers.isGenericValueTask t -> + let task = t.GetMethod("AsTask").Invoke(x, null) + wrapReturnValue task + + | t when ReflectionHelpers.isAsync t -> + let asyncResultType = t.GetGenericArguments()[0] + // Use toAsyncObj to avoid InvalidCastException, then wrap in Property + let asyncObj = toAsyncObj x asyncResultType + Property.ofAsync asyncObj |> Property.map wrapReturnValue |> Property.bind id + + | t when ReflectionHelpers.isResult t -> + // Wrap the Result in a Property and use map to check it + // This ensures exceptions from resultIsOk are caught by Property.map + Property.success x + |> Property.map (fun r -> + ReflectionHelpers.assertResultOk r typeof.DeclaringType AssertResultOkMethodName |> ignore) + + | _ -> Property.success () + +// ======================================== +// 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 + +// ======================================== +// Generator Creation +// ======================================== + +module private GeneratorFactory = + /// Tries to get a custom generator from GenAttribute on a parameter + let tryGetAttributeGenerator (parameterInfo: ParameterInfo) : Gen option = + parameterInfo.GetCustomAttributes() + |> Seq.tryPick (fun attr -> + let attrType = attr.GetType().BaseType + + let isGenAttribute = + attrType.IsGenericType + && attrType.GetGenericTypeDefinition().IsAssignableFrom(typedefof>) + + if isGenAttribute then + let boxMethod = attrType.GetMethods() |> Array.find (fun m -> m.Name = "Box") + boxMethod.Invoke(attr, null) :?> Gen |> Some + else + None) + + /// Creates a generator for a parameter based on attribute or type + let createGenerator (autoGenConfig: obj) (parameter: ParameterInfo) : Gen = + match tryGetAttributeGenerator parameter, parameter.ParameterType.ContainsGenericParameters with + | Some gen, _ -> gen + | _, true -> Gen.constant Unchecked.defaultof<_> + | _, false -> + 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 + +// ======================================== +// Property Creation +// ======================================== + +module private PropertyBuilder = + /// Invokes the test method with the given arguments + let invokeTestMethod (testMethod: MethodInfo) (testClassInstance: obj) (args: obj list) : obj = + let methodToInvoke = + if testMethod.ContainsGenericParameters then + let genericArgs = Array.create (testMethod.GetGenericArguments().Length) typeof + testMethod.MakeGenericMethod(genericArgs) + else + testMethod + + methodToInvoke.Invoke(testClassInstance, args |> Array.ofList) + + + /// Creates a property based on the test method's return type + let createProperty + (testMethod: MethodInfo) + (testClassInstance: obj) + (parameters: ParameterInfo[]) + (gens: Gen) + : Property = + + let invoke args = + try + try + invokeTestMethod testMethod testClassInstance args + finally + List.iter dispose args + with + // Unwrap TargetInvocationException to get the actual exception. + // It is safe to do it because invokeTestMethod uses reflection that adds this wrapper. + | :? TargetInvocationException as e when not (isNull e.InnerException) -> box e.InnerException + | e -> box e + + let createJournal args = + args + |> 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 + + let wrapWithExceptionHandling (result: obj) : Property = + match result with + | :? exn as e -> Property.exn e + | _ -> wrapReturnValue result + + + // Handle Property return type + if testMethod.ReturnType = typeof> then + Property.bindWith createJournal (invoke >> unbox>) gens + + // Handle Property return type + elif testMethod.ReturnType = typeof> then + Property.bindWith createJournal (invoke >> unbox>) gens + |> Property.falseToFailure + + // Handle all other return types (Task, Async, bool, Result, etc.) + else + Property.bindWith createJournal (invoke >> wrapWithExceptionHandling) gens + + +// ======================================== +// Report Generation +// ======================================== + +let reportAsync (context: PropertyContext) (testMethod: MethodInfo) testClassInstance : Async = + let parameters = testMethod.GetParameters() + let gens = GeneratorFactory.createParameterListGenerator context parameters + + let property = + PropertyBuilder.createProperty testMethod testClassInstance parameters gens + + let config = + PropertyConfig.defaults + |> withTests context.Tests + |> withShrinks context.Shrinks + + match context.Recheck with + | Some recheckData -> Property.reportRecheckWith recheckData config property |> async.Return + | None -> Property.reportAsyncWith config property 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/PropertyContext.fs b/tests/Hedgehog.MSTest/PropertyContext.fs new file mode 100644 index 00000000..69120351 --- /dev/null +++ b/tests/Hedgehog.MSTest/PropertyContext.fs @@ -0,0 +1,63 @@ +// 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. + +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 + Recheck: string option } + +module internal PropertyContext = + let defaults: PropertyContext = + { AutoGenConfig = AutoGenConfig.defaults + Tests = None + Shrinks = None + Size = 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 } + + let fromMethod (method: MethodInfo) = + let propertyAttribute = + method.GetCustomAttributes() + |> Seq.cast + |> Seq.filter (fun attr -> attr :? IPropertyAttribute) + |> Seq.exactlyOne + :?> IPropertyAttribute + + let classAttributes = + method.DeclaringType |> Type.getAllAttributes + + 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..3bd564e1 --- /dev/null +++ b/tests/Hedgehog.MSTest/RecheckAttribute.fs @@ -0,0 +1,19 @@ +// 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. + +namespace Hedgehog.MSTest + +open System + +/// Runs Property.reportRecheck +[] +type RecheckAttribute(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..dcc48b6c --- /dev/null +++ b/tests/Hedgehog.MSTest/ReflectionHelpers.fs @@ -0,0 +1,50 @@ +// 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: none. + +/// Reflection utilities for type checking and method invocation +module internal ReflectionHelpers + +open System +open System.Reflection +open System.Threading +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> + +// ======================================== +// Method Invocation +// ======================================== + +let invokeAwaitTask (taskObj: obj) = + let taskType = taskObj.GetType() + + let awaitTaskMethod = + typeof.GetMethods() + |> Array.find (fun m -> m.Name = "AwaitTask" && m.IsGenericMethod) + + awaitTaskMethod.MakeGenericMethod(taskType.GetGenericArguments().[0]).Invoke(null, [| taskObj |]) + +let assertResultOk (resultObj: obj) (markerType: Type) (resultIsOkMethodName: string) = + markerType + .GetTypeInfo() + .GetDeclaredMethod(resultIsOkMethodName) + .MakeGenericMethod(resultObj.GetType().GetGenericArguments()) + .Invoke(null, [| resultObj |]) From 8e804a5133ee7a1c147a2b253674b43a1fdafe89 Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 3 Oct 2026 04:24:47 +0200 Subject: [PATCH 2/8] test: add the Hedgehog MSTest property attribute Turn the ported sources into an MSTest adapter (ADR 0001, section 22.6). PropertyAttribute derives from TestMethodAttribute and, like it, applies to methods only and is not inherited. It keeps upstream's six constructor overloads and named settings (AutoGenConfig, AutoGenConfigArgs, Tests, Shrinks, Size), forwards the caller information of every constructor to the base constructor, as STATestMethodAttribute does, and overrides ExecuteAsync. MSTest has no counterpart to NUnit's test builder or xUnit's discoverer, so this one attribute is the framework layer; PropertiesAttribute is copied from upstream with the same settings. Each generated case and each shrink step is one call of ITestMethod.InvokeAsync, never MethodInfo.Invoke, so MSTest creates the test class, injects the TestContext and runs TestInitialize, TestCleanup and Dispose for every case, and applies a [] to each of them. The values of a [] or [] row, which MSTest passes in ITestMethod.Arguments, are the leading arguments and also appear in the report; only the parameters after them are generated. Generated IDisposable arguments are disposed after their invocation. The run is folded into one TestResult, because several results from one ExecuteAsync appear as separate results of one test: a failure carries Hedgehog's report with the shrunk arguments, the exception of the counterexample as inner exception (unwrapped from MSTest's internal TestFailedException), the output of its invocation and a [] to add next to the method's Property attribute, which keeps the attribute's settings, such as its AutoGenConfig, so that the recheck data replays this counterexample. A run that gives up after Hedgehog's 100 discards fails, as in upstream. Additions beyond upstream: a uint64 Seed setting on both attributes; Assert.Inconclusive in an invocation discards the case, and fails it while rechecking, because a recheck cannot discard its only case; a run whose TestContext cancellation token is cancelled stops without shrinking, reading the token before every invocation, because MSTest gives the TestContext a new token source before each TestCleanup, and checking it again after the invocation, whatever its outcome: MSTest reports a test method that returns without observing its cancelled token as passed, and after the last case nothing else would notice the token, so the property stops in the same way wherever the cancellation reached it; the run still disposes the arguments generated for a case it keeps from running; an invocation whose outcome is none of Passed, Failed, Inconclusive and Timeout, such as Error, was not run as a test by MSTest, so the run stops at it without shrinking and the property reports the outcome and the exception of that invocation instead of a counterexample. The token comes from TestContext.Current, experimental in MSTest 4.2.3 (MSTESTEXP), in one helper with a scoped #nowarn "57". Departures from upstream, each recorded in the header of the changed file: class settings come from the reflected type of the method, so a property inherited from an abstract base gets the settings of each derived test class, and a derived class's [] win over its base's; a GenAttribute is found through a new non-generic GenAttribute base wherever it sits in the inheritance chain (upstream checks only the direct base type and silently auto-generates otherwise); generic methods, which MSTest 4.2.3 discovers, and return types other than unit, Task and ValueTask, which MSTest 4 cannot discover, are rejected before any generator is built, so the return-value handling and the reflection-based invocation of upstream's InternalLogic and ReflectionHelpers are removed; every invocation is memoised per shrink-tree node, because Hedgehog 2.0.4 runs an asynchronous case again whenever it unwraps it and would invoke the counterexample a second time to read its journal; the recheck, which is synchronous in Hedgehog 2.0.4, runs on the thread pool; the generic arguments of an AutoGenConfig method are inferred from every place a generic parameter occurs in its parameter types, nested ones such as 'a[] included, and every place must give the same type, where upstream takes one argument type per parameter that is itself a generic parameter, which fails for 'a list or a repeated 'a; 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; Odd and Even are generated from the odd or even values inside their range and reject a range without one, where upstream sets or clears the lowest bit of any value of the range and so leaves an even upper bound of Odd or an odd lower bound of Even by one; any exception, an invalid AutoGenConfig type or malformed recheck data included, becomes a result with the outcome Error instead of escaping ExecuteAsync. InternalLogic.executeAsync, a function from the method, the data row, an invoker and a function that reads the cancellation token to a TestResult, is the entry point of ExecuteAsync; InternalsVisibleTo exposes it to the adapter's suite, so the suite can run properties that fail by design without failing itself. The repository turns GenerateAssemblyInfo off for the FAKE-written AssemblyInfo.fs of the src projects, so this project turns it back on for the SDK to emit the InternalsVisibleTo attribute. Every public type and member is documented, and every reference to a type or member is a documentation ID that resolves in the documentation files of the referenced assemblies, including the primary constructors, whose comments sit before their parameters. THIRD-PARTY-NOTICES.md lists the two attribute files. Co-Authored-By: Claude Opus 5.5 --- THIRD-PARTY-NOTICES.md | 3 +- tests/Hedgehog.MSTest/AutoGenConfig.fs | 74 ++- tests/Hedgehog.MSTest/GenAttribute.Prelude.fs | 396 +++++++++++--- tests/Hedgehog.MSTest/GenAttribute.fs | 71 ++- tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj | 12 + tests/Hedgehog.MSTest/IPropertyAttribute.fs | 3 +- tests/Hedgehog.MSTest/InternalLogic.fs | 508 ++++++++++++------ tests/Hedgehog.MSTest/PropertiesAttribute.fs | 119 ++++ tests/Hedgehog.MSTest/PropertyAttribute.fs | 228 ++++++++ tests/Hedgehog.MSTest/PropertyContext.fs | 14 +- tests/Hedgehog.MSTest/RecheckAttribute.fs | 20 +- tests/Hedgehog.MSTest/ReflectionHelpers.fs | 27 +- 12 files changed, 1196 insertions(+), 279 deletions(-) create mode 100644 tests/Hedgehog.MSTest/PropertiesAttribute.fs create mode 100644 tests/Hedgehog.MSTest/PropertyAttribute.fs diff --git a/THIRD-PARTY-NOTICES.md b/THIRD-PARTY-NOTICES.md index d9c424dc..74c0c8ee 100644 --- a/THIRD-PARTY-NOTICES.md +++ b/THIRD-PARTY-NOTICES.md @@ -10,7 +10,8 @@ to it in a header comment. The rest of the repository is covered by [LICENSE](LI (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` and `InternalLogic.fs` + `GenAttribute.Prelude.fs`, `PropertyContext.fs`, `InternalLogic.fs`, `PropertiesAttribute.fs` and, adapted from + NUnit to MSTest, `PropertyAttribute.fs` * License: Apache License, Version 2.0 ```text diff --git a/tests/Hedgehog.MSTest/AutoGenConfig.fs b/tests/Hedgehog.MSTest/AutoGenConfig.fs index c84c6387..786d3247 100644 --- a/tests/Hedgehog.MSTest/AutoGenConfig.fs +++ b/tests/Hedgehog.MSTest/AutoGenConfig.fs @@ -3,14 +3,79 @@ // 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. +// 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 [||] @@ -29,12 +94,7 @@ type %s{configType.Name} = |> fun methodInfo -> let methodInfo = if methodInfo.IsGenericMethod then - methodInfo.GetParameters() - |> Array.map _.ParameterType.IsGenericParameter - |> Array.zip configArgs - |> Array.filter snd - |> Array.map (fun (arg, _) -> arg.GetType()) - |> fun argTypes -> methodInfo.MakeGenericMethod argTypes + methodInfo.MakeGenericMethod(inferGenericArguments methodInfo configArgs) else methodInfo diff --git a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs index 6ecbbe8e..031ef234 100644 --- a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs +++ b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs @@ -3,7 +3,10 @@ // 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. +// 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; Odd and Even stay inside their range, where upstream leaves an even upper or an odd lower +// bound by one, and reject a range without such a value. namespace Hedgehog.MSTest @@ -31,158 +34,419 @@ module private RangeHelpers = | size when size > MediumRangeThreshold -> Range.linearFrom origin min max | _ -> Range.constantFrom origin min max -/// Generates an integer within a specified range. -/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). -type IntAttribute(min: int, max: int) = + /// The range narrowed to its first and last odd or even value, so that moving a generated value onto that parity + /// cannot leave the range. A range without such a value is rejected. + let parityRangeInt32 (odd: bool) (min: int) (max: int) : Range = + let isOffParity (value: int) = (value % 2 <> 0) <> odd + // int64, because the neighbour of Int32.MinValue or Int32.MaxValue would overflow + let first = if isOffParity min then int64 min + 1L else int64 min + let last = if isOffParity max then int64 max - 1L else int64 max + + if first > last then + let parity = if odd then "odd" else "even" + invalidArg (nameof min) $"The range from %d{min} to %d{max} holds no %s{parity} value." + + chooseRangeInt32 (int first) (int last) + +/// +/// 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 integer from Int32.MinValue to Int32.MaxValue. - /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + /// + /// Generates an from to + /// . + /// new() = IntAttribute(Int32.MinValue, Int32.MaxValue) + /// override _.Generator = Gen.int32 (chooseRangeInt32 min max) -/// Generates an odd integer. -/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). -type OddAttribute(min: int, max: int) = +/// +/// Generates an odd from to , both included. +/// +/// +/// The range is narrowed to its first and last odd value and then chosen as for +/// ; a range without an odd value is rejected. Upstream sets the lowest bit of +/// any value of the range, which exceeds an even by one. +/// +type OddAttribute + /// + /// Creates the attribute. + /// + /// The smallest value. + /// The largest value. + (min: int, max: int) = inherit GenAttribute() - /// Generates an odd integer from Int32.MinValue to Int32.MaxValue. - /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + /// + /// 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 integer. -/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). -type EvenAttribute(min: int, max: int) = + /// + override _.Generator = + let range = parityRangeInt32 true min max + + gen { + let! n = Gen.int32 range + return n ||| 1 + } + +/// +/// Generates an even from to , both included. +/// +/// +/// The range is narrowed to its first and last even value and then chosen as for +/// ; a range without an even value is rejected. Upstream clears the lowest +/// bit of any value of the range, which falls below an odd by one. +/// +type EvenAttribute + /// + /// Creates the attribute. + /// + /// The smallest value. + /// The largest value. + (min: int, max: int) = inherit GenAttribute() - /// Generates an even integer from Int32.MinValue to Int32.MaxValue. - /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + /// + /// 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 integer. -/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). -type PositiveIntAttribute(max: int) = + /// + override _.Generator = + let range = parityRangeInt32 false min max + + gen { + let! n = Gen.int32 range + 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 integer from 1 to Int32.MaxValue. - /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + /// + /// Generates a positive from 1 to . + /// new() = PositiveIntAttribute(Int32.MaxValue) + /// override _.Generator = Gen.int32 (chooseRangeInt32 1 max) -/// Generates a non-negative integer. -/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). -type NonNegativeIntAttribute(max: int) = +/// +/// 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 integer from 0 to Int32.MaxValue. - /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + /// + /// Generates a non-negative from 0 to . + /// new() = NonNegativeIntAttribute(Int32.MaxValue) + /// override _.Generator = Gen.int32 (chooseRangeInt32 0 max) -/// Generates a non-zero integer. -/// Range strategy: exponential (>1000), linear (>100), or constant (≤100). -type NonZeroIntAttribute(min: int, max: int) = +/// +/// 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 integer from Int32.MinValue+1 to Int32.MaxValue. - /// Range strategy: exponential (>1000), linear (>100), or constant (≤100). + /// + /// 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 - | n, m -> // 0 is in range, split it + | 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 string that is a valid identifier. -type IdentifierAttribute(maxLen: int) = +/// +/// 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 string representing a Latin name. -type LatinNameAttribute(maxLength: int) = +/// +/// 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 string in snake_case. -type SnakeCaseAttribute(maxWordLength: int, maxWordsCount: int) = +/// +/// 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 string in kebab-case. -type KebabCaseAttribute(maxWordLength: int, maxWordsCount: int) = +/// +/// 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 valid domain name. -type DomainNameAttribute() = +/// +/// Generates a that is a valid domain name, through +/// . +/// +type DomainNameAttribute + /// + /// Creates the attribute. + /// + () = inherit GenAttribute() + /// override _.Generator = Gen.domainName -/// Generates a valid email address. -type EmailAttribute() = +/// +/// Generates a that is a valid email address, through +/// . +/// +type EmailAttribute + /// + /// Creates the attribute. + /// + () = inherit GenAttribute() + /// override _.Generator = Gen.email -/// Generates a DateTime value. -type DateTimeAttribute(kind: DateTimeKind, from: DateTime, duration: TimeSpan) = +/// +/// 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 DateTimeOffset value. -type DateTimeOffsetAttribute(from: DateTimeOffset, duration: TimeSpan) = +/// +/// 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 string containing alphanumeric characters. -type AlphaNumStringAttribute(minLength: int, maxLength: int) = +/// +/// 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 string containing unicode characters. -type UnicodeStringAttribute(minLength: int, maxLength: int) = +/// +/// 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 IP address (IPv4). -type Ipv4AddressAttribute() = +/// +/// Generates an IPv4 , through . +/// +type Ipv4AddressAttribute + /// + /// Creates the attribute. + /// + () = inherit GenAttribute() + /// override _.Generator = Gen.ipv4Address -/// Generates an IPv6 address. -type Ipv6AddressAttribute() = +/// +/// 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 index 2e8e96e8..d02b87c3 100644 --- a/tests/Hedgehog.MSTest/GenAttribute.fs +++ b/tests/Hedgehog.MSTest/GenAttribute.fs @@ -3,7 +3,8 @@ // 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. +// 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 @@ -11,25 +12,63 @@ open System open Hedgehog open Hedgehog.FSharp -/// Set a Generator for a parameter of a test annotated with `Property` -/// -/// Example usage: -/// -/// ``` -/// +/// +/// 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() +/// inherit GenAttribute<int>() /// override _.Generator = Gen.constant i /// -/// [] -/// let ``is always 2`` ([] i) = -/// Assert.AreEqual(2, i) -/// -/// ``` +/// [<Property>] +/// member _.``is always 2`` ([<ConstantInt(2)>] i) = +/// Assert.AreEqual(2, i, "the attribute sets the value") +/// +/// [] [] -type GenAttribute<'a>() = - inherit Attribute() +type GenAttribute<'a> + /// + /// Called by the constructors of derived attributes. + /// + () = + inherit GenAttribute() + /// + /// The generator of the parameter. + /// abstract member Generator: Gen<'a> - member this.Box() = this.Generator |> Gen.map box + + /// + /// 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 index ac43d103..9264a09c 100644 --- a/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj +++ b/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj @@ -21,6 +21,7 @@ --> false false + true + + + + @@ -42,6 +52,8 @@ + + diff --git a/tests/Hedgehog.MSTest/IPropertyAttribute.fs b/tests/Hedgehog.MSTest/IPropertyAttribute.fs index 09017646..9879f7f1 100644 --- a/tests/Hedgehog.MSTest/IPropertyAttribute.fs +++ b/tests/Hedgehog.MSTest/IPropertyAttribute.fs @@ -3,7 +3,7 @@ // 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. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the Seed setting is added. namespace Hedgehog.MSTest @@ -19,3 +19,4 @@ type internal IPropertyAttribute = 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 index 7cb6b989..5d6ba732 100644 --- a/tests/Hedgehog.MSTest/InternalLogic.fs +++ b/tests/Hedgehog.MSTest/InternalLogic.fs @@ -3,15 +3,33 @@ // 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. +// 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, which is +// checked before every invocation and after it, whatever its outcome, 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; +// - an invocation whose outcome is none of Passed, Failed, Inconclusive and Timeout, such as Error, did not run the test +// method as a test: the run stops at it without shrinking, and its result is the result of the property; +// - 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 // ======================================== @@ -23,91 +41,11 @@ type private TypedReflectionMarker = class end [] let private GenxAutoBoxMethodName = "genxAutoBoxWith" -[] -let private AssertResultOkMethodName = "assertResultOk" - -[] -let private ConvertAsyncToObjMethodName = "convertAsyncToObj" - -let private convertAsyncToObj<'T> (a: Async<'T>) : Async = - async { - let! x = a - return box x - } - let private genxAutoBoxWith<'T> x = x |> Gen.autoWith<'T> |> Gen.map box let private genxAutoBoxWithMethodInfo = typeof.DeclaringType.GetTypeInfo().GetDeclaredMethod(GenxAutoBoxMethodName) -let private convertAsyncToObjMethodInfo = - typeof.DeclaringType.GetTypeInfo().GetDeclaredMethod(ConvertAsyncToObjMethodName) - -// ======================================== -// Result Validation -// ======================================== - -let assertResultOk r = - match r with - | Ok _ -> () - | Error e -> failwithf $"Result is in the Error case with the following value:%s{Environment.NewLine}%A{e}" - -// ======================================== -// Return Value Processing -// ======================================== - -let private toAsyncObj (asyncVal: obj) (t: Type) : Async = - convertAsyncToObjMethodInfo.MakeGenericMethod(t).Invoke(null, [| asyncVal |]) - |> unbox> - -/// Wraps a test method return value into a Property, handling async/task natively -let rec wrapReturnValue (x: obj) : Property = - match x with - | null -> Property.success () - | :? bool as b -> Property.ofBool b - | :? Property as p -> p - | :? Property as p -> p |> Property.falseToFailure - - // Non-generic Task - | :? Task as t when not (t.GetType().IsGenericType) -> Property.ofTaskUnit t - - // Non-generic ValueTask - | :? ValueTask as vt -> vt.AsTask() |> Property.ofTaskUnit - - // Async - common case, avoid reflection - | :? Async as a -> Property.ofAsync a |> Property.map (fun _ -> ()) - - // Generic types requiring reflection - | x -> - let t = x.GetType() - - match t with - | t when ReflectionHelpers.isGenericTask t -> - let taskResultType = t.GetGenericArguments()[0] - let asyncVal = ReflectionHelpers.invokeAwaitTask x - // Use toAsyncObj to avoid InvalidCastException, then wrap in Property - let asyncObj = toAsyncObj asyncVal taskResultType - Property.ofAsync asyncObj |> Property.map wrapReturnValue |> Property.bind id - - | t when ReflectionHelpers.isGenericValueTask t -> - let task = t.GetMethod("AsTask").Invoke(x, null) - wrapReturnValue task - - | t when ReflectionHelpers.isAsync t -> - let asyncResultType = t.GetGenericArguments()[0] - // Use toAsyncObj to avoid InvalidCastException, then wrap in Property - let asyncObj = toAsyncObj x asyncResultType - Property.ofAsync asyncObj |> Property.map wrapReturnValue |> Property.bind id - - | t when ReflectionHelpers.isResult t -> - // Wrap the Result in a Property and use map to check it - // This ensures exceptions from resultIsOk are caught by Property.map - Property.success x - |> Property.map (fun r -> - ReflectionHelpers.assertResultOk r typeof.DeclaringType AssertResultOkMethodName |> ignore) - - | _ -> Property.success () - // ======================================== // Resource Management // ======================================== @@ -131,33 +69,59 @@ let withShrinks = | 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 GenAttribute on a parameter + /// 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 (fun attr -> - let attrType = attr.GetType().BaseType - - let isGenAttribute = - attrType.IsGenericType - && attrType.GetGenericTypeDefinition().IsAssignableFrom(typedefof>) - - if isGenAttribute then - let boxMethod = attrType.GetMethods() |> Array.find (fun m -> m.Name = "Box") - boxMethod.Invoke(attr, null) :?> Gen |> Some - else - None) + |> 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, parameter.ParameterType.ContainsGenericParameters with - | Some gen, _ -> gen - | _, true -> Gen.constant Unchecked.defaultof<_> - | _, false -> + match tryGetAttributeGenerator parameter with + | Some gen -> gen + | None -> genxAutoBoxWithMethodInfo.MakeGenericMethod(parameter.ParameterType).Invoke(null, [| autoGenConfig |]) :?> Gen @@ -175,85 +139,313 @@ module private GeneratorFactory = | None, _ -> gens // ======================================== -// Property Creation +// Invocation // ======================================== -module private PropertyBuilder = - /// Invokes the test method with the given arguments - let invokeTestMethod (testMethod: MethodInfo) (testClassInstance: obj) (args: obj list) : obj = - let methodToInvoke = - if testMethod.ContainsGenericParameters then - let genericArgs = Array.create (testMethod.GetGenericArguments().Length) typeof - testMethod.MakeGenericMethod(genericArgs) - else - testMethod - - methodToInvoke.Invoke(testClassInstance, args |> Array.ofList) +/// 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 result of the invocation that MSTest could not run as a test; the run stopped at it + RunnerFailure: TestResult voption } + +/// 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 + member val RunnerFailure: TestResult voption = ValueNone with get, set +[] +let private TestFailedExceptionTypeName = + "Microsoft.VisualStudio.TestPlatform.MSTest.TestAdapter.ObjectModel.TestFailedException" + +/// The exception that an invocation reports, or one that names its outcome when it reports none +let private reportedExceptionOf (result: TestResult) : exn = + match result.TestFailureException with + | null -> InvalidOperationException($"The invocation of the test method ended with the outcome %O{result.Outcome}.") + | error -> error + +/// 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 reportedExceptionOf result with + | error when + String.Equals(error.GetType().FullName, TestFailedExceptionTypeName, StringComparison.Ordinal) + && not (isNull error.InnerException) + -> + error.InnerException + | error -> error - /// Creates a property based on the test method's return type +module private PropertyBuilder = + /// Creates a property whose every case invokes the test method once let createProperty - (testMethod: MethodInfo) - (testClassInstance: obj) + (state: RunState) + (rechecking: bool) + (cancellationToken: unit -> CancellationToken) + (invoke: obj array -> Task) (parameters: ParameterInfo[]) + (dataRow: obj array) (gens: Gen) : Property = - let invoke args = - try - try - invokeTestMethod testMethod testClassInstance args - finally - List.iter dispose args - with - // Unwrap TargetInvocationException to get the actual exception. - // It is safe to do it because invokeTestMethod uses reflection that adds this wrapper. - | :? TargetInvocationException as e when not (isNull e.InnerException) -> box e.InnerException - | e -> box e - - let createJournal args = - args + // A case that does not run is discarded, but the arguments generated for it are disposed all the same + let skip (generated: obj list) (reason: string) : Journal * Outcome = + List.iter dispose generated + Journal.singletonMessage $"Not run: %s{reason}", Discard + + 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.RunnerFailure.IsSome then + return skip generated "an earlier invocation did not run the test method as a test." + elif state.Cancelled || token.IsCancellationRequested then + state.Cancelled <- true + return skip generated "the TestContext cancellation token is cancelled." + 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 it is an error of the runner, not a failed case + return TestResult(Outcome = UnitTestOutcome.Error, TestFailureException = e) + finally + List.iter dispose generated + } + + state.Invocations <- state.Invocations + 1 + + // A [] cancels the token of the invocation it applies to, and a cancelled run cancels it as + // well. The token is checked after every invocation, whatever its outcome: MSTest reports Passed for + // a test method that returns without observing its cancelled token, and after the last case nothing + // else would notice it. So the property stops in the same way wherever the cancellation reached it. + if token.IsCancellationRequested then + state.Cancelled <- true + + 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 + // The test method ran and its case is falsified + | UnitTestOutcome.Failed + | UnitTestOutcome.Inconclusive + | UnitTestOutcome.Timeout -> + // After a cancelled token no shrink step runs: every one of them would wait for the same + // timeout again, so the property reports this case as it is. + state.LastFailure <- ValueSome result + return Journal.exn (exceptionOf result), Failure + // Any other outcome, such as Error or NotFound, says that MSTest could not run the test method as a + // test. No smaller case would fare better, so the run stops here without shrinking: the cases that + // Hedgehog still asks for are skipped, and this result becomes the result of the property. + | _ -> + state.RunnerFailure <- ValueSome result + return Journal.exn (reportedExceptionOf 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 - let wrapWithExceptionHandling (result: obj) : Property = - match result with - | :? exn as e -> Property.exn e - | _ -> wrapReturnValue result - - - // Handle Property return type - if testMethod.ReturnType = typeof> then - Property.bindWith createJournal (invoke >> unbox>) gens - - // Handle Property return type - elif testMethod.ReturnType = typeof> then - Property.bindWith createJournal (invoke >> unbox>) gens - |> Property.falseToFailure - - // Handle all other return types (Task, Async, bool, Result, etc.) - else - Property.bindWith createJournal (invoke >> wrapWithExceptionHandling) gens - + 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 // ======================================== -let reportAsync (context: PropertyContext) (testMethod: MethodInfo) testClassInstance : Async = - let parameters = testMethod.GetParameters() - let gens = GeneratorFactory.createParameterListGenerator context parameters +/// 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 + RunnerFailure = state.RunnerFailure } + } - let property = - PropertyBuilder.createProperty testMethod testClassInstance parameters gens +// ======================================== +// MSTest Results +// ======================================== - let config = - PropertyConfig.defaults - |> withTests context.Tests - |> withShrinks context.Shrinks +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: []" + | _ -> "" + +/// The result of the property, with the output of the invocation that it reports +let private resultOf + (outcome: UnitTestOutcome) + (error: exn) + (source: TestResult voption) + (summary: string) + (duration: TimeSpan) + = + match source with + | ValueSome source -> + TestResult( + Outcome = outcome, + TestFailureException = error, + LogOutput = summary + Environment.NewLine + source.LogOutput, + LogError = source.LogError, + DebugTrace = source.DebugTrace, + TestContextMessages = source.TestContextMessages, + ResultFiles = source.ResultFiles, + Duration = duration + ) + | ValueNone -> TestResult(Outcome = outcome, TestFailureException = error, LogOutput = summary, Duration = duration) + +/// A failed property; the invocation that failed is the counterexample that the message shows +let private failedResult (message: string) (failure: TestResult voption) (summary: string) (duration: TimeSpan) = + let error = + match failure with + | ValueSome source -> AssertFailedException(message, exceptionOf source) + | ValueNone -> AssertFailedException(message) + + resultOf UnitTestOutcome.Failed error failure summary 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." + + match run.RunnerFailure with + | ValueSome source -> + // Not a counterexample, so nothing of Hedgehog's report applies: the property ends with the outcome and the + // exception of the invocation that MSTest could not run, as a plain test method would + let stopped = + $"The property stopped after %d{run.Invocations} invocations without shrinking, because an invocation ended " + + $"with the outcome %O{source.Outcome}: MSTest did not run the test method as a test." + + resultOf + source.Outcome + (reportedExceptionOf source) + run.RunnerFailure + (summary + Environment.NewLine + stopped) + duration + | ValueNone when run.Cancelled -> + 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 + | ValueNone -> + 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 + } - match context.Recheck with - | Some recheckData -> Property.reportRecheckWith recheckData config property |> async.Return - | None -> Property.reportAsyncWith config property +/// 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/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..35352cc6 --- /dev/null +++ b/tests/Hedgehog.MSTest/PropertyAttribute.fs @@ -0,0 +1,228 @@ +// 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. An invocation that ends with any other outcome, such as +/// , says that MSTest could not run the +/// test method as a test: the property stops at it without shrinking and reports the outcome and the exception of that +/// invocation. +/// +/// +/// +/// +/// [<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 index 69120351..d228ee61 100644 --- a/tests/Hedgehog.MSTest/PropertyContext.fs +++ b/tests/Hedgehog.MSTest/PropertyContext.fs @@ -3,7 +3,9 @@ // 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. +// 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 @@ -17,6 +19,7 @@ type internal PropertyContext = Tests: int option Shrinks: int option Size: Size option + Seed: uint64 option Recheck: string option } module internal PropertyContext = @@ -25,6 +28,7 @@ module internal PropertyContext = Tests = None Shrinks = None Size = None + Seed = None Recheck = None } let private append (ctx: PropertyContext) (attr: IPropertyAttribute) : PropertyContext = @@ -39,7 +43,8 @@ module internal PropertyContext = AutoGenConfig = config Tests = attr.Tests |> Option.orElse ctx.Tests Shrinks = attr.Shrinks |> Option.orElse ctx.Shrinks - Size = attr.Size |> Option.orElse ctx.Size } + Size = attr.Size |> Option.orElse ctx.Size + Seed = attr.Seed |> Option.orElse ctx.Seed } let fromMethod (method: MethodInfo) = let propertyAttribute = @@ -49,8 +54,11 @@ module internal PropertyContext = |> 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.DeclaringType |> Type.getAllAttributes + method.ReflectedType |> Type.getAllAttributes |> List.rev let context = [ propertyAttribute ] |> Seq.append classAttributes |> Seq.fold append defaults diff --git a/tests/Hedgehog.MSTest/RecheckAttribute.fs b/tests/Hedgehog.MSTest/RecheckAttribute.fs index 3bd564e1..d00c5de7 100644 --- a/tests/Hedgehog.MSTest/RecheckAttribute.fs +++ b/tests/Hedgehog.MSTest/RecheckAttribute.fs @@ -3,15 +3,29 @@ // 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. +// Changes: the namespace Hedgehog.NUnit is renamed to Hedgehog.MSTest; the documentation is rewritten. namespace Hedgehog.MSTest open System -/// Runs Property.reportRecheck +/// +/// 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(recheckData) = +type RecheckAttribute + /// + /// Replays the counterexample that describes. + /// + /// The recheck data that the failed run reported. + (recheckData) = inherit Attribute() let _recheckData: string = recheckData diff --git a/tests/Hedgehog.MSTest/ReflectionHelpers.fs b/tests/Hedgehog.MSTest/ReflectionHelpers.fs index dcc48b6c..95995a02 100644 --- a/tests/Hedgehog.MSTest/ReflectionHelpers.fs +++ b/tests/Hedgehog.MSTest/ReflectionHelpers.fs @@ -3,14 +3,13 @@ // 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: none. +// 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 and method invocation +/// Reflection utilities for type checking module internal ReflectionHelpers open System -open System.Reflection -open System.Threading open System.Threading.Tasks // ======================================== @@ -28,23 +27,3 @@ let isAsync (t: Type) = let isResult (t: Type) = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> - -// ======================================== -// Method Invocation -// ======================================== - -let invokeAwaitTask (taskObj: obj) = - let taskType = taskObj.GetType() - - let awaitTaskMethod = - typeof.GetMethods() - |> Array.find (fun m -> m.Name = "AwaitTask" && m.IsGenericMethod) - - awaitTaskMethod.MakeGenericMethod(taskType.GetGenericArguments().[0]).Invoke(null, [| taskObj |]) - -let assertResultOk (resultObj: obj) (markerType: Type) (resultIsOkMethodName: string) = - markerType - .GetTypeInfo() - .GetDeclaredMethod(resultIsOkMethodName) - .MakeGenericMethod(resultObj.GetType().GetGenericArguments()) - .Invoke(null, [| resultObj |]) From bd709abad22c54beddf4cfd7423d4b8305faaec0 Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 10 Oct 2026 14:02:10 +0200 Subject: [PATCH 3/8] test: apply the repository's conventions to the Hedgehog MSTest adapter The adapter was ported in upstream's style, because the same code was to go into the upstream pull request. That pull request now exists, hedgehogqa/fsharp-hedgehog#487, with its own copy in upstream's style, so the copy in this repository follows the coding guidelines of this repository, its formatting and nullness checking included, as the review of #43 asks: - A setting that is not given is a voption instead of an option: the members of IPropertyAttribute, the fields of PropertyContext, the private constructors and fields of PropertyAttribute and PropertiesAttribute, the generic arguments that AutoGenConfig infers and the generator that a GenAttribute gives. - The project compiles src/Shared/ValueCollections.fs again, like every other F# project, and uses its Seq.tryHead, Seq.tryFind, Seq.tryExactlyOne and Seq.zip, which return a voption or struct tuples. The three files that use them open FSharp.Azure.Cosmos, the namespace of these functions. Prelude loses Option.requireSome and Seq.seqTryExactlyOne. - The generated arguments are an array instead of a list. Hedgehog 2.0.4 has Gen.sequence for sequences and Gen.sequenceList for lists, both over one traversal, and nothing for arrays, so Prelude adds Gen.sequenceArray over Gen.sequence; the values shrink as they did through Gen.sequenceList. Type.getAllAttributes returns an array, and the two parts of a NonZeroInt range are an array. - Collections are joined in array and sequence expressions instead of Array.append and Seq.append: the arguments of an invocation, the values of the journal and the attributes that PropertyContext folds. - The types that the adapter compares other types with are in one module, KnownTypes: Void, Task, ValueTask, IAutoGenConfig and the generic definitions of ValueTask<'T>, Async<'T> and Result<'T, 'E>. typeof is one ldtoken, but typedefof calls GetGenericTypeDefinition on every use (read in the compiled IL), so each type is resolved once, and every comparison goes through the operators of System.Type instead of generic equality. - withTests, withShrinks and withSeed are functions with named parameters instead of values that hold a lambda. - Attributes are found through GetCustomAttributes<'T> and OfType<'T> instead of a type test and a cast per attribute. - The error for an AutoGenConfig type without exactly one config member says "member" where upstream says "property": a method that takes AutoGenConfigArgs is accepted as well (automatic review of #50). - The project is formatted with Fantomas: .fantomasignore no longer lists it, so the Fantomas run of the build covers it. - Nullness checking is on, as everywhere in the repository. A data row and the arguments of an invocation or of a config method may hold null, so they are arrays of objnull. A null array is checked for where it enters: in the setters of AutoGenConfigArgs, which take it as no arguments, and at the entry point that receives the data row from MSTest. Nested exceptions and base types are matched on null instead of tested with isNull, reflection lookups that cannot fail are asserted with nonNull, and a config method that returns no IAutoGenConfig is an error. One call keeps a scoped #nowarn "3261", in a helper of its own: ITestMethod.InvokeAsync declares the elements of its arguments as non-null, although MSTest itself passes it ITestMethod.Arguments, whose elements it declares as nullable. - The pipeline that builds the journal ends in Seq.toArray, so that it stays in one module. The header of every changed file records the change. Co-Authored-By: Claude Opus 5.5 --- .fantomasignore | 3 - tests/Hedgehog.MSTest/AutoGenConfig.fs | 128 +++-- tests/Hedgehog.MSTest/GenAttribute.Prelude.fs | 195 ++++---- tests/Hedgehog.MSTest/GenAttribute.fs | 17 +- tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj | 23 +- tests/Hedgehog.MSTest/IPropertyAttribute.fs | 16 +- tests/Hedgehog.MSTest/InternalLogic.fs | 463 +++++++++--------- tests/Hedgehog.MSTest/KnownTypes.fs | 48 ++ tests/Hedgehog.MSTest/Prelude.fs | 60 +-- tests/Hedgehog.MSTest/PropertiesAttribute.fs | 81 ++- tests/Hedgehog.MSTest/PropertyAttribute.fs | 178 +++++-- tests/Hedgehog.MSTest/PropertyContext.fs | 78 +-- tests/Hedgehog.MSTest/RecheckAttribute.fs | 8 +- tests/Hedgehog.MSTest/ReflectionHelpers.fs | 23 +- 14 files changed, 771 insertions(+), 550 deletions(-) create mode 100644 tests/Hedgehog.MSTest/KnownTypes.fs diff --git a/.fantomasignore b/.fantomasignore index cadd6707..d9f2aa7f 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -1,5 +1,2 @@ # Ignore AssemblyInfo files AssemblyInfo.fs - -# The Hedgehog MSTest adapter follows the conventions of hedgehogqa/fsharp-hedgehog, where the same code is proposed -tests/Hedgehog.MSTest/ diff --git a/tests/Hedgehog.MSTest/AutoGenConfig.fs b/tests/Hedgehog.MSTest/AutoGenConfig.fs index 786d3247..9a1d18a0 100644 --- a/tests/Hedgehog.MSTest/AutoGenConfig.fs +++ b/tests/Hedgehog.MSTest/AutoGenConfig.fs @@ -6,84 +6,114 @@ // 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. +// generic parameter; a type that is not inferred yet is a voption, types are compared through Type.(=), and the one +// config method is found with the Seq.tryExactlyOne of this repository's collection helpers; the error for a type +// without exactly one such method says "member" where upstream says "property", because a method that takes +// AutoGenConfigArgs is accepted as well; the arguments may hold null, a null array of them counts as none where the +// attributes take it (argsOrNone), and a config method that returns no IAutoGenConfig is an error. +// The file is formatted with Fantomas, under the settings of this repository. namespace Hedgehog.MSTest open System open System.Reflection open Hedgehog +// For the collection functions of this repository that return a voption or struct tuples +open FSharp.Azure.Cosmos 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() + let private inferGenericArguments (configType : Type) (methodInfo : MethodInfo) (configArgs : objnull 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}." + $"%s{configType.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 genericParameters = methodInfo.GetGenericArguments () + let inferred : Type voption array = Array.create genericParameters.Length ValueNone - let rec baseTypes (t: Type) = - seq { - match t.BaseType with - | null -> () - | baseType -> - yield baseType - yield! baseTypes baseType - } + let rec baseTypes (t : Type) = seq { + match t.BaseType with + | null -> () + | baseType -> + yield baseType + yield! baseTypes baseType + } - let rec unify (parameterType: Type) (argumentType: Type) = + 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 -> + | ValueNone -> inferred.[position] <- ValueSome argumentType + | ValueSome earlier when Type.(=) (earlier, argumentType) -> () + | ValueSome 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 + // An array type has an element type + unify (nonNull (parameterType.GetElementType ())) (nonNull (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() + let definition = parameterType.GetGenericTypeDefinition () seq { yield argumentType yield! baseTypes argumentType - yield! argumentType.GetInterfaces() + yield! argumentType.GetInterfaces () } - |> Seq.tryFind (fun t -> t.IsGenericType && t.GetGenericTypeDefinition() = definition) - |> Option.iter (fun constructed -> - Array.iter2 unify (parameterType.GetGenericArguments()) (constructed.GetGenericArguments())) + |> Seq.tryFind (fun t -> + t.IsGenericType + && Type.(=) (t.GetGenericTypeDefinition (), definition) + ) + |> ValueOption.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())) + (fun (parameter : ParameterInfo) (configArg : objnull) -> + // A null argument says nothing about the type of its parameter + match configArg with + | null -> () + | configArg -> unify parameter.ParameterType (configArg.GetType ()) + ) parameters configArgs inferred |> Array.mapi (fun index inferredType -> match inferredType with - | Some t -> t - | None -> + | ValueSome t -> t + | ValueNone -> 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. + $"The generic parameter %s{genericParameters.[index].Name} of %s{methodInfo.Name} cannot be inferred from AutoGenConfigArgs." + ) + + /// The arguments as they are given, or none for the null that a caller compiled without nullness checking can give + let argsOrNone (configArgs : objnull array) : objnull array = + match withNull configArgs with + | null -> [||] + | configArgs -> configArgs + + let instantiate (configType : Type) (configArgs : objnull array) : IAutoGenConfig = + let methodInfo = + match + configType.GetMethods () + |> Seq.filter (fun p -> + p.IsStatic + && Type.(=) (p.ReturnType, KnownTypes.autoGenConfig) + ) + |> Seq.tryExactlyOne + with + | ValueSome methodInfo -> methodInfo + | ValueNone -> + failwith + $"%s{configType.FullName} must have exactly one public static member that returns an AutoGenConfig. An example type definition: @@ -91,11 +121,13 @@ 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 + + let methodInfo = + if methodInfo.IsGenericMethod then + methodInfo.MakeGenericMethod (inferGenericArguments configType methodInfo configArgs) + else + methodInfo + + match methodInfo.Invoke (null, configArgs) with + | :? IAutoGenConfig as config -> config + | _ -> failwith $"%s{configType.FullName}.%s{methodInfo.Name} returned no AutoGenConfig." diff --git a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs index 031ef234..f737c3aa 100644 --- a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs +++ b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs @@ -7,6 +7,7 @@ // 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; Odd and Even stay inside their range, where upstream leaves an even upper or an odd lower // bound by one, and reject a range without such a value. +// The file is formatted with Fantomas, under the settings of this repository. namespace Hedgehog.MSTest @@ -26,7 +27,7 @@ module private RangeHelpers = /// - 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 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 @@ -36,8 +37,8 @@ module private RangeHelpers = /// The range narrowed to its first and last odd or even value, so that moving a generated value onto that parity /// cannot leave the range. A range without such a value is rejected. - let parityRangeInt32 (odd: bool) (min: int) (max: int) : Range = - let isOffParity (value: int) = (value % 2 <> 0) <> odd + let parityRangeInt32 (odd : bool) (min : int) (max : int) : Range = + let isOffParity (value : int) = (value % 2 <> 0) <> odd // int64, because the neighbour of Int32.MinValue or Int32.MaxValue would overflow let first = if isOffParity min then int64 min + 1L else int64 min let last = if isOffParity max then int64 max - 1L else int64 max @@ -61,16 +62,16 @@ type IntAttribute /// /// The smallest value. /// The largest value. - (min: int, max: int) = - inherit GenAttribute() + (min : int, max : int) + = + inherit GenAttribute () /// /// Generates an from to /// . /// - new() = IntAttribute(Int32.MinValue, Int32.MaxValue) + new () = IntAttribute (Int32.MinValue, Int32.MaxValue) /// - override _.Generator = - Gen.int32 (chooseRangeInt32 min max) + override _.Generator = Gen.int32 (chooseRangeInt32 min max) /// /// Generates an odd from to , both included. @@ -86,12 +87,13 @@ type OddAttribute /// /// The smallest value. /// The largest value. - (min: int, max: int) = - inherit GenAttribute() + (min : int, max : int) + = + inherit GenAttribute () /// /// Generates an odd from the whole range of . /// - new() = OddAttribute(Int32.MinValue, Int32.MaxValue) + new () = OddAttribute (Int32.MinValue, Int32.MaxValue) /// override _.Generator = let range = parityRangeInt32 true min max @@ -115,12 +117,13 @@ type EvenAttribute /// /// The smallest value. /// The largest value. - (min: int, max: int) = - inherit GenAttribute() + (min : int, max : int) + = + inherit GenAttribute () /// /// Generates an even from the whole range of . /// - new() = EvenAttribute(Int32.MinValue, Int32.MaxValue) + new () = EvenAttribute (Int32.MinValue, Int32.MaxValue) /// override _.Generator = let range = parityRangeInt32 false min max @@ -141,15 +144,15 @@ type PositiveIntAttribute /// Creates the attribute. /// /// The largest value. - (max: int) = - inherit GenAttribute() + (max : int) + = + inherit GenAttribute () /// /// Generates a positive from 1 to . /// - new() = PositiveIntAttribute(Int32.MaxValue) + new () = PositiveIntAttribute (Int32.MaxValue) /// - override _.Generator = - Gen.int32 (chooseRangeInt32 1 max) + override _.Generator = Gen.int32 (chooseRangeInt32 1 max) /// /// Generates a non-negative from 0 to . @@ -162,15 +165,15 @@ type NonNegativeIntAttribute /// Creates the attribute. /// /// The largest value. - (max: int) = - inherit GenAttribute() + (max : int) + = + inherit GenAttribute () /// /// Generates a non-negative from 0 to . /// - new() = NonNegativeIntAttribute(Int32.MaxValue) + new () = NonNegativeIntAttribute (Int32.MaxValue) /// - override _.Generator = - Gen.int32 (chooseRangeInt32 0 max) + override _.Generator = Gen.int32 (chooseRangeInt32 0 max) /// /// Generates a non-zero from to . @@ -186,26 +189,24 @@ type NonZeroIntAttribute /// /// The smallest value. /// The largest value. - (min: int, max: int) = - inherit GenAttribute() + (min : int, max : int) + = + inherit GenAttribute () /// /// Generates a non-zero from + 1 to /// . /// - new() = NonZeroIntAttribute(Int32.MinValue + 1, Int32.MaxValue) + 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) - ] + | _, 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 @@ -216,15 +217,15 @@ type IdentifierAttribute /// Creates the attribute. /// /// The largest length. - (maxLen: int) = - inherit GenAttribute() + (maxLen : int) + = + inherit GenAttribute () /// /// Generates an identifier of up to 25 characters. /// - new() = IdentifierAttribute(25) + new () = IdentifierAttribute (25) /// - override _.Generator = - Gen.identifier maxLen + override _.Generator = Gen.identifier maxLen /// /// Generates a that is a Latin name, through @@ -235,15 +236,15 @@ type LatinNameAttribute /// Creates the attribute. /// /// The largest length. - (maxLength: int) = - inherit GenAttribute() + (maxLength : int) + = + inherit GenAttribute () /// /// Generates a Latin name of up to 20 characters. /// - new() = LatinNameAttribute(20) + new () = LatinNameAttribute (20) /// - override _.Generator = - Gen.latinName maxLength + override _.Generator = Gen.latinName maxLength /// /// Generates a in snake case, such as snake_case, through @@ -255,15 +256,15 @@ type SnakeCaseAttribute /// /// The largest length of one word. /// The largest number of words. - (maxWordLength: int, maxWordsCount: int) = - inherit GenAttribute() + (maxWordLength : int, maxWordsCount : int) + = + inherit GenAttribute () /// /// Generates up to 5 words of up to 5 characters each in snake case. /// - new() = SnakeCaseAttribute(5, 5) + new () = SnakeCaseAttribute (5, 5) /// - override _.Generator = - Gen.snakeCase (Range.constant 1 maxWordLength) (Range.constant 1 maxWordsCount) + override _.Generator = Gen.snakeCase (Range.constant 1 maxWordLength) (Range.constant 1 maxWordsCount) /// /// Generates a in kebab case, such as kebab-case, through @@ -275,15 +276,15 @@ type KebabCaseAttribute /// /// The largest length of one word. /// The largest number of words. - (maxWordLength: int, maxWordsCount: int) = - inherit GenAttribute() + (maxWordLength : int, maxWordsCount : int) + = + inherit GenAttribute () /// /// Generates up to 5 words of up to 5 characters each in kebab case. /// - new() = KebabCaseAttribute(5, 5) + new () = KebabCaseAttribute (5, 5) /// - override _.Generator = - Gen.kebabCase (Range.constant 1 maxWordLength) (Range.constant 1 maxWordsCount) + override _.Generator = Gen.kebabCase (Range.constant 1 maxWordLength) (Range.constant 1 maxWordsCount) /// /// Generates a that is a valid domain name, through @@ -293,11 +294,11 @@ type DomainNameAttribute /// /// Creates the attribute. /// - () = - inherit GenAttribute() + () + = + inherit GenAttribute () /// - override _.Generator = - Gen.domainName + override _.Generator = Gen.domainName /// /// Generates a that is a valid email address, through @@ -307,11 +308,11 @@ type EmailAttribute /// /// Creates the attribute. /// - () = - inherit GenAttribute() + () + = + inherit GenAttribute () /// - override _.Generator = - Gen.email + override _.Generator = Gen.email /// /// Generates a of the given from to @@ -324,29 +325,29 @@ type DateTimeAttribute /// The of every value. /// The earliest value. /// How much later than the latest value is. - (kind: DateTimeKind, from: DateTime, duration: TimeSpan) = - inherit GenAttribute() + (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)) + 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) + 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)) + new (kind) = DateTimeAttribute (kind, DateTime (2000, 1, 1), TimeSpan.FromDays (3650)) /// - override _.Generator = - Gen.dateTime (Range.constant from (from + duration)) (Gen.constant kind) + override _.Generator = Gen.dateTime (Range.constant from (from + duration)) (Gen.constant kind) /// /// Generates a from to plus @@ -358,20 +359,20 @@ type DateTimeOffsetAttribute /// /// The earliest value. /// How much later than the latest value is. - (from: DateTimeOffset, duration: TimeSpan) = - inherit GenAttribute() + (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)) + 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)) + new (from) = DateTimeOffsetAttribute (from, TimeSpan.FromDays (3650)) /// - override _.Generator = - Gen.dateTimeOffset (Range.constant from (from + duration)) + override _.Generator = Gen.dateTimeOffset (Range.constant from (from + duration)) /// /// Generates a of ASCII letters and digits, from to @@ -383,21 +384,21 @@ type AlphaNumStringAttribute /// /// The smallest length. /// The largest length. - (minLength: int, maxLength: int) = - inherit GenAttribute() + (minLength : int, maxLength : int) + = + inherit GenAttribute () /// /// Generates a of ASCII letters and digits, up to 256 characters long. /// - new() = AlphaNumStringAttribute(0, 256) + new () = AlphaNumStringAttribute (0, 256) /// /// Generates a of ASCII letters and digits, from to 256 /// characters long. /// /// The smallest length. - new(minLength) = AlphaNumStringAttribute(minLength, 256) + new (minLength) = AlphaNumStringAttribute (minLength, 256) /// - override _.Generator = - Gen.string (Range.constant minLength maxLength) Gen.alphaNum + override _.Generator = Gen.string (Range.constant minLength maxLength) Gen.alphaNum /// /// Generates a of Unicode characters, from to @@ -409,21 +410,21 @@ type UnicodeStringAttribute /// /// The smallest length. /// The largest length. - (minLength: int, maxLength: int) = - inherit GenAttribute() + (minLength : int, maxLength : int) + = + inherit GenAttribute () /// /// Generates a of Unicode characters, up to 256 characters long. /// - new() = UnicodeStringAttribute(0, 256) + new () = UnicodeStringAttribute (0, 256) /// /// Generates a of Unicode characters, from to 256 /// characters long. /// /// The smallest length. - new(minLength) = UnicodeStringAttribute(minLength, 256) + new (minLength) = UnicodeStringAttribute (minLength, 256) /// - override _.Generator = - Gen.string (Range.constant minLength maxLength) Gen.unicode + override _.Generator = Gen.string (Range.constant minLength maxLength) Gen.unicode /// /// Generates an IPv4 , through . @@ -432,11 +433,11 @@ type Ipv4AddressAttribute /// /// Creates the attribute. /// - () = - inherit GenAttribute() + () + = + inherit GenAttribute () /// - override _.Generator = - Gen.ipv4Address + override _.Generator = Gen.ipv4Address /// /// Generates an IPv6 , through . @@ -445,8 +446,8 @@ type Ipv6AddressAttribute /// /// Creates the attribute. /// - () = - inherit GenAttribute() + () + = + inherit GenAttribute () /// - override _.Generator = - Gen.ipv6Address + override _.Generator = Gen.ipv6Address diff --git a/tests/Hedgehog.MSTest/GenAttribute.fs b/tests/Hedgehog.MSTest/GenAttribute.fs index d02b87c3..d73e645f 100644 --- a/tests/Hedgehog.MSTest/GenAttribute.fs +++ b/tests/Hedgehog.MSTest/GenAttribute.fs @@ -5,6 +5,7 @@ // (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. +// The file is formatted with Fantomas, under the settings of this repository. namespace Hedgehog.MSTest @@ -27,13 +28,14 @@ type GenAttribute /// /// Called by the constructors of derived attributes. /// - () = - inherit Attribute() + () + = + inherit Attribute () /// /// Returns the generator of the parameter with its values boxed. /// - abstract member Box: unit -> Gen + abstract member Box : unit -> Gen /// /// Sets the generator of one parameter of a method marked with . @@ -60,15 +62,16 @@ type GenAttribute<'a> /// /// Called by the constructors of derived attributes. /// - () = - inherit GenAttribute() + () + = + inherit GenAttribute () /// /// The generator of the parameter. /// - abstract member Generator: Gen<'a> + abstract member Generator : Gen<'a> /// /// Returns with its values boxed. /// - override this.Box() = this.Generator |> Gen.map box + override this.Box () = this.Generator |> Gen.map box diff --git a/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj b/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj index 9264a09c..29ff2e1e 100644 --- a/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj +++ b/tests/Hedgehog.MSTest/Hedgehog.MSTest.fsproj @@ -2,17 +2,18 @@ net10.0 Hedgehog.MSTest true - disable - - - - + AND '$(MSBuildProjectName)' != 'Hedgehog.MSTest' + AND '$(MSBuildProjectName)' != 'Hedgehog.MSTest.Tests'"> diff --git a/tests/Hedgehog.MSTest.Tests/Common.fs b/tests/Hedgehog.MSTest.Tests/Common.fs new file mode 100644 index 00000000..0bd85e98 --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/Common.fs @@ -0,0 +1,57 @@ +// 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. +// The file is formatted with Fantomas, under the settings of this repository. + +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..ec699541 --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/GenAttributePreludeTests.fs @@ -0,0 +1,160 @@ +// 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, and of Odd and Even at the ends of their +// range. +// The file is formatted with Fantomas, under the settings of this repository. + +namespace Hedgehog.MSTest.Tests + +open System +open System.Net +open System.Net.Sockets +open Microsoft.VisualStudio.TestTools.UnitTesting +open Hedgehog.MSTest + +/// 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 _.``Odd stays inside a range that ends with an even value`` ([] i : int) = + Assert.IsInRange (1, 9, i, "The value lies in the range.") + Assert.AreNotEqual (0, i % 2, "The value is odd.") + + [] + member _.``Odd generates the only odd value of its range`` ([] i : int) = + Assert.AreEqual (-1, i, "-1 is the only odd value from -1 to 0.") + + [] + member _.``Odd reaches Int32.MaxValue without overflow`` ([] i : int) = + Assert.AreEqual (Int32.MaxValue, i, "Int32.MaxValue is the only odd value of the range.") + + [] + member _.``Even stays inside a range that starts with an odd value`` ([] i : int) = + Assert.IsInRange (2, 10, i, "The value lies in the range.") + Assert.AreEqual (0, i % 2, "The value is even.") + + [] + member _.``Even generates the only even value of its range`` ([] i : int) = + Assert.AreEqual (0, i, "0 is the only even value from -1 to 0.") + + [] + member _.``Even reaches Int32.MinValue without overflow`` ([] i : int) = + Assert.AreEqual (Int32.MinValue, i, "Int32.MinValue is the only even value of the range.") + + [] + member _.``Odd rejects a range without an odd value`` () = + Assert.ThrowsExactly( + Action (fun () -> OddAttribute(0, 0).Generator |> ignore), + "The range from 0 to 0 holds no odd value." + ) + |> ignore + + [] + member _.``Even rejects a range without an even value`` () = + Assert.ThrowsExactly( + Action (fun () -> EvenAttribute(1, 1).Generator |> ignore), + "The range from 1 to 1 holds no even value." + ) + |> ignore + + [] + 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..68fe563f --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/Harness.fs @@ -0,0 +1,213 @@ +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 Microsoft.VisualStudio.TestTools.UnitTesting +open Hedgehog +open Hedgehog.MSTest + +/// +/// 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) : objnull array -> Task = + fun arguments -> task { + // A method that was looked up on a class has that class as its reflected type + let instance = + if testMethod.IsStatic then + null + else + Activator.CreateInstance (nonNull 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 -> + match e.InnerException with + | null -> error + | inner -> inner + | 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 : objnull 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 + + /// The exception of a result; a result without one fails the test. + let failureOf (result : TestResult) : exn = + match result.TestFailureException with + | null -> raise (AssertFailedException "A property that does not pass must report an exception.") + | error -> error + + /// The standard output of a result, or an empty string. + let outputOf (result : TestResult) : string = + match result.LogOutput with + | null -> "" + | output -> output + +/// +/// 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 = 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.") + let failure = Harness.failureOf result + let message = failure.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 = String.Concat (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 ( + failure.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..351d8989 --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/Hedgehog.MSTest.Tests.fsproj @@ -0,0 +1,42 @@ + + + + + net10.0 + + 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..444e72ef --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/MSTestTests.fs @@ -0,0 +1,709 @@ +// 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, timeouts and invocations that MSTest could not +// run. 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 Microsoft.VisualStudio.TestTools.UnitTesting +open Hedgehog +open Hedgehog.MSTest + +/// 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 = Unchecked.defaultof 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 = Unchecked.defaultof 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 : objnull 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 = ValueSome 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( + (Harness.failureOf result).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 : objnull 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 token cancelled during a passing invocation stops the run`` (cancelledAt : int) : Task = task { + use cancellation = new CancellationTokenSource () + // Runs 20 cases + let testMethod = Harness.methodOf "seed 42" + let invoked = ResizeArray() + + // Passes every case and cancels the token while one of them runs, as a cooperative [] does for a + // test method that returns without observing its token: MSTest reports such an invocation as passed + let cancelling (arguments : objnull array) = task { + invoked.Add arguments + + if invoked.Count = cancelledAt then + cancellation.Cancel () + + return TestResult (Outcome = UnitTestOutcome.Passed) + } + + let! run = + Harness.runWithAsync (PropertyContext.fromMethod testMethod) testMethod cancelling (fun () -> cancellation.Token) + Assert.IsTrue (run.Cancelled, "The run notices the token that was cancelled during a passing invocation.") + Assert.HasCount (cancelledAt, invoked, "No case runs after the one whose token was cancelled.") + let result = InternalLogic.toTestResult run TimeSpan.Zero + Assert.AreEqual ( + UnitTestOutcome.Failed, + result.Outcome, + "A stopped property fails, wherever the cancellation reached it." + ) + + Assert.Contains ( + $"stopped after %d{cancelledAt} 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 _.``an invocation that MSTest could not run stops the run and gives its result to the property`` + (outcome : UnitTestOutcome) + : Task + = task { + let testMethod = Harness.methodOf "seed 42" + let error : exn = InvalidOperationException "The runner fails by design." + let invoked = ResizeArray() + + // The third invocation ends as MSTest ends one whose test method it could not run; the earlier ones pass + let failingAtThird (arguments : objnull array) = task { + invoked.Add arguments + + if invoked.Count = 3 then + return TestResult (Outcome = outcome, TestFailureException = error, LogOutput = "output of the third invocation") + else + return TestResult (Outcome = UnitTestOutcome.Passed) + } + + let! run = + Harness.runWithAsync + (PropertyContext.fromMethod testMethod) + testMethod + failingAtThird + (fun () -> CancellationToken.None) + Assert.HasCount ( + 3, + invoked, + "Neither a further case nor a shrink step is invoked after the one that MSTest could not run." + ) + Assert.AreEqual (3, run.Invocations, "The run counts the invocations that happened.") + Assert.IsTrue (run.RunnerFailure.IsSome, "The run keeps the result of the invocation that MSTest could not run.") + Assert.IsFalse (run.Cancelled, "The run did not stop because of the cancellation token.") + let result = InternalLogic.toTestResult run TimeSpan.Zero + Assert.AreEqual (outcome, result.Outcome, "The property ends with the outcome of that invocation instead of Failed.") + Assert.AreSame (error, result.TestFailureException, "The property reports the exception of that invocation as it is.") + + Assert.Contains ( + "stopped after 3 invocations without shrinking", + Harness.outputOf result, + StringComparison.Ordinal, + "The output explains why the property stopped." + ) + + Assert.Contains ( + "output of the third invocation", + Harness.outputOf result, + StringComparison.Ordinal, + "The output of that invocation is kept." + ) + } + + [] + member _.``an exception of the invoker stops the run with an error result`` () : Task = task { + let testMethod = Harness.methodOf "seed 42" + let error : exn = InvalidOperationException "The invoker fails by design." + let invoked = ResizeArray() + + // MSTest reports what a test method throws in the result, so an exception of InvokeAsync comes from MSTest + let throwing (arguments : objnull array) : Task = + invoked.Add arguments + raise error + + let! run = + Harness.runWithAsync (PropertyContext.fromMethod testMethod) testMethod throwing (fun () -> CancellationToken.None) + Assert.HasCount (1, invoked, "Neither a further case nor a shrink step is invoked after the exception.") + let result = InternalLogic.toTestResult run TimeSpan.Zero + Assert.AreEqual (UnitTestOutcome.Error, result.Outcome, "An exception of the invoker is an error, not a failed case.") + Assert.AreSame (error, result.TestFailureException, "The property reports the exception of the invoker as it is.") + } + + [] + 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 : objnull 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 (ValueSome 3, context.Tests, "The base class sets the number of tests.") + Assert.AreEqual (ValueSome 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 (ValueSome 7, context.Tests, "The derived class's number of tests wins.") + Assert.AreEqual (ValueSome 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 = Unchecked.defaultof 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..c8880929 --- /dev/null +++ b/tests/Hedgehog.MSTest.Tests/PropertyTests.fs @@ -0,0 +1,735 @@ +// 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, and a test of a +// null array of AutoGenConfigArgs. The misspellings +// "overriden", "properites" and "arg get disposed" in test names are corrected. +// The file is formatted with Fantomas, under the settings of this repository. + +namespace Hedgehog.MSTest.Tests + +open System +open System.Threading +open System.Threading.Tasks +open Microsoft.VisualStudio.TestTools.UnitTesting +open Hedgehog +open Hedgehog.FSharp +open Hedgehog.MSTest + +/// 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 = Unchecked.defaultof 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 member 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 (ValueSome 1, context.Tests, "The attribute sets the number of tests.") + Assert.AreEqual (ValueNone, 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 member", + 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 |> Seq.toArray + // 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." + ) + + [] + member _.``AutoGenConfigArgs set to null are no arguments`` () = + // The null that a caller compiled without nullness checking can give + let noArguments = Unchecked.defaultof + let ofProperty = PropertyAttribute (AutoGenConfigArgs = noArguments) :> IPropertyAttribute + let ofProperties = PropertiesAttribute (AutoGenConfigArgs = noArguments) :> IPropertyAttribute + Assert.IsEmpty (ofProperty.AutoGenConfigArgs, "The Property attribute takes a null array as no arguments.") + Assert.IsEmpty (ofProperties.AutoGenConfigArgs, "The Properties attribute takes a null array as no arguments.") + +/// 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 (ValueSome 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 (ValueSome 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 (ValueSome 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 (ValueSome 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 (ValueSome 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 (ValueSome 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 (ValueSome 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 (ValueSome 1, size99.Size, "The context sees the attribute's Size.") + Assert.AreEqual (ValueSome 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 (ValueSome 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 (ValueSome 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 + } + } +} From c5602bc37cdf47a6c3468608551178e9d77cdf85 Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 10 Oct 2026 14:10:21 +0200 Subject: [PATCH 5/8] test: add `DateOnly` and `TimeOnly` generator attributes to the Hedgehog MSTest adapter Hedgehog 2.0.4 cannot auto-generate a DateOnly or a TimeOnly: Gen.auto throws for both (run in dotnet fsi against the package), and upstream's adapters have a generator attribute for DateTime and DateTimeOffset only. A property with a parameter of one of these types therefore needed a generator of its own; the review of #43 asks for the two attributes. DateOnlyAttribute generates a date between two dates, both included, and TimeOnlyAttribute a time of day between two times, both included, at the precision of TimeOnly (100 nanoseconds). Both ranges are constant, like those of DateTimeAttribute: they do not grow with the size of a case, and a value shrinks towards the lower end. Without arguments DateOnly generates within the 3650 days from 2000-01-01, the dates of DateTimeAttribute's default range, and TimeOnly any time of day. An attribute argument cannot be a DateOnly or a TimeOnly, so each attribute also takes its range as integers, [] and []; the constructor that takes the two values themselves serves attributes that derive from these. Six tests cover the default and the given ranges through [] methods and check on 200 sampled values that a range of three values gives each of them, both ends included, and nothing else. Co-Authored-By: Claude Opus 5.5 --- .../GenAttributePreludeTests.fs | 63 ++++++++++++++- tests/Hedgehog.MSTest/GenAttribute.Prelude.fs | 81 ++++++++++++++++++- 2 files changed, 141 insertions(+), 3 deletions(-) diff --git a/tests/Hedgehog.MSTest.Tests/GenAttributePreludeTests.fs b/tests/Hedgehog.MSTest.Tests/GenAttributePreludeTests.fs index ec699541..fff56b60 100644 --- a/tests/Hedgehog.MSTest.Tests/GenAttributePreludeTests.fs +++ b/tests/Hedgehog.MSTest.Tests/GenAttributePreludeTests.fs @@ -4,8 +4,8 @@ // 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, and of Odd and Even at the ends of their -// range. +// tests of NonZeroInt with 0 at either end of its range and from 0 to 0, of Odd and Even at the ends of their range, +// and of DateOnly and TimeOnly, which upstream does not have. // The file is formatted with Fantomas, under the settings of this repository. namespace Hedgehog.MSTest.Tests @@ -14,6 +14,7 @@ open System open System.Net open System.Net.Sockets open Microsoft.VisualStudio.TestTools.UnitTesting +open Hedgehog.FSharp open Hedgehog.MSTest /// Ported from upstream's "GenAttribute Prelude tests". @@ -158,3 +159,61 @@ type ``GenAttribute Prelude tests`` () = dto, "The date lies in the default range." ) + + [] + member _.``DateOnly generates dates of the default range`` ([] date : DateOnly) = + Assert.IsInRange (DateOnly (2000, 1, 1), DateOnly (2009, 12, 29), date, "The date lies in the 3650 days from 2000-01-01.") + + [] + member _.``DateOnly generates dates of the given range`` ([] date : DateOnly) = + Assert.IsInRange (DateOnly (2024, 2, 28), DateOnly (2024, 3, 1), date, "The date lies in the range.") + + [] + member _.``DateOnly generates every date of its range, both ends included`` () = + let generated = + DateOnlyAttribute(2024, 2, 28, 2024, 3, 1).Generator + |> Gen.sample 10 200 + |> Seq.distinct + |> Seq.sort + |> Seq.toArray + + CollectionAssert.AreEqual ( + [| DateOnly (2024, 2, 28); DateOnly (2024, 2, 29); DateOnly (2024, 3, 1) |], + generated, + "200 values of a range of three dates hold each of them and nothing else." + ) + + [] + member _.``TimeOnly generates times of the given range`` ([] time : TimeOnly) = + Assert.IsInRange (TimeOnly (9, 0), TimeOnly (17, 30), time, "The time lies in the range.") + + [] + member _.``TimeOnly generates every time of its range, both ends included`` () = + // The typed constructor, which derived attributes call: three values, 100 nanoseconds apart + let generated = + TimeOnlyAttribute(TimeOnly (0L), TimeOnly (2L)).Generator + |> Gen.sample 10 200 + |> Seq.distinct + |> Seq.sort + |> Seq.toArray + + CollectionAssert.AreEqual ( + [| TimeOnly (0L); TimeOnly (1L); TimeOnly (2L) |], + generated, + "200 values of a range of three times hold each of them and nothing else." + ) + + [] + member _.``TimeOnly without a range generates times of the whole day at full precision`` () = + let generated = + TimeOnlyAttribute().Generator + |> Gen.sample 99 200 + |> Seq.toArray + Assert.Contains ((fun (time : TimeOnly) -> time.Hour < 12), generated, "Some of 200 times lie before noon.") + Assert.Contains ((fun (time : TimeOnly) -> time.Hour >= 12), generated, "Some of 200 times lie after noon.") + + Assert.Contains ( + (fun (time : TimeOnly) -> time.Ticks % TimeSpan.TicksPerSecond <> 0L), + generated, + "A time has the precision of TimeOnly, not whole seconds." + ) diff --git a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs index f737c3aa..990dbc5a 100644 --- a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs +++ b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs @@ -6,7 +6,7 @@ // 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; Odd and Even stay inside their range, where upstream leaves an even upper or an odd lower -// bound by one, and reject a range without such a value. +// bound by one, and reject a range without such a value; DateOnlyAttribute and TimeOnlyAttribute are added. // The file is formatted with Fantomas, under the settings of this repository. namespace Hedgehog.MSTest @@ -374,6 +374,85 @@ type DateTimeOffsetAttribute /// override _.Generator = Gen.dateTimeOffset (Range.constant from (from + duration)) +/// +/// Generates a from to , both included. +/// +/// +/// The range is constant: it does not grow with the size of a case, and a value shrinks towards +/// . Upstream's adapters have no such attribute, and Hedgehog 2.0.4 cannot auto-generate a +/// , so a parameter of this type needs this attribute or a generator of its own. +/// +type DateOnlyAttribute + /// + /// Creates the attribute from two dates. An attribute argument cannot be a , so this + /// constructor serves attributes that derive from this one. + /// + /// The earliest value. + /// The latest value. + (min : DateOnly, max : DateOnly) + = + inherit GenAttribute () + /// + /// Generates a within the 3650 days from 2000-01-01, the dates of the default range + /// of . + /// + new () = DateOnlyAttribute (DateOnly (2000, 1, 1), DateOnly(2000, 1, 1).AddDays(3650)) + /// + /// Generates a from the first date to the second, both included. + /// + /// The year of the earliest value. + /// The month of the earliest value. + /// The day of the earliest value. + /// The year of the latest value. + /// The month of the latest value. + /// The day of the latest value. + new (minYear : int, minMonth : int, minDay : int, maxYear : int, maxMonth : int, maxDay : int) + = + DateOnlyAttribute (DateOnly (minYear, minMonth, minDay), DateOnly (maxYear, maxMonth, maxDay)) + /// + override _.Generator = + Gen.int32 (Range.constant min.DayNumber max.DayNumber) + |> Gen.map DateOnly.FromDayNumber + +/// +/// Generates a from to , both included. +/// +/// +/// A value has the full precision of , 100 nanoseconds. The range is constant: it does +/// not grow with the size of a case, and a value shrinks towards . Upstream's adapters have no +/// such attribute, and Hedgehog 2.0.4 cannot auto-generate a , so a parameter of this +/// type needs this attribute or a generator of its own. +/// +type TimeOnlyAttribute + /// + /// Creates the attribute from two times of day. An attribute argument cannot be a , + /// so this constructor serves attributes that derive from this one. + /// + /// The earliest value. + /// The latest value. + (min : TimeOnly, max : TimeOnly) + = + inherit GenAttribute () + /// + /// Generates any , from to + /// . + /// + new () = TimeOnlyAttribute (TimeOnly.MinValue, TimeOnly.MaxValue) + /// + /// Generates a from the first time of day to the second, both included. + /// + /// The hour of the earliest value. + /// The minute of the earliest value. + /// The hour of the latest value. + /// The minute of the latest value. + new (minHour : int, minMinute : int, maxHour : int, maxMinute : int) + = + TimeOnlyAttribute (TimeOnly (minHour, minMinute), TimeOnly (maxHour, maxMinute)) + /// + override _.Generator = + Gen.int64 (Range.constant min.Ticks max.Ticks) + |> Gen.map TimeOnly + /// /// Generates a of ASCII letters and digits, from to /// characters long. From d7da7028540df8780e1049cba2cd88a59cefcbe6 Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sun, 11 Oct 2026 22:40:11 +0200 Subject: [PATCH 6/8] test: generate `DateOnly` and `TimeOnly` for a property without an attribute Hedgehog 2.0.4 has no generator of the two types: `Gen.auto` calls a constructor of the type with integers that it generates, and the constructor refuses them. So a parameter of such a type, or of a type that holds one, needed `[]`, `[]` or a generator of the test. hedgehogqa/fsharp-hedgehog#488 adds the two default generators to Hedgehog itself. Until a release has them, the adapter registers the same two for the parameters of a property: the configuration that a property starts from is `AutoGenConfig.propertyDefaults`, the defaults of Hedgehog and these generators. The configuration that a test names is merged over it as before, so a generator of the test still wins, and so does an attribute on the parameter. A date lies around 2000-01-01, further away the larger a case is. A time of day lies anywhere in the day, later the larger a case is. The suite has a test that fails as soon as Hedgehog generates the two types by itself: `propertyDefaults` goes then. Co-Authored-By: Claude Opus 5.5 --- tests/Hedgehog.MSTest.Tests/MSTestTests.fs | 107 +++++++++++++++++- tests/Hedgehog.MSTest/AutoGenConfig.fs | 36 +++++- tests/Hedgehog.MSTest/GenAttribute.Prelude.fs | 13 ++- tests/Hedgehog.MSTest/PropertyContext.fs | 5 +- 4 files changed, 151 insertions(+), 10 deletions(-) diff --git a/tests/Hedgehog.MSTest.Tests/MSTestTests.fs b/tests/Hedgehog.MSTest.Tests/MSTestTests.fs index 444e72ef..64a347bc 100644 --- a/tests/Hedgehog.MSTest.Tests/MSTestTests.fs +++ b/tests/Hedgehog.MSTest.Tests/MSTestTests.fs @@ -1,8 +1,9 @@ // 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, timeouts and invocations that MSTest could not -// run. Each pins MSTest behaviour that the adapter relies on, so the suite runs on every MSTest update. +// through the inheritance chain, memoised invocations, cancellation, timeouts, invocations that MSTest could not +// run, and DateOnly and TimeOnly parameters without an attribute. Each pins behaviour of MSTest or Hedgehog that the +// adapter relies on, so the suite runs on every update of the two. namespace Hedgehog.MSTest.Tests open System @@ -10,6 +11,7 @@ open System.Threading open System.Threading.Tasks open Microsoft.VisualStudio.TestTools.UnitTesting open Hedgehog +open Hedgehog.FSharp open Hedgehog.MSTest /// The function under test of the failure report tests: it loses the last item of a list of three or more items. @@ -707,3 +709,104 @@ type ``Timeout tests`` () = [] member this.``a timed-out invocation stops the property without shrinking`` (_ : int) : Task = Task.Delay (TimeSpan.FromSeconds 30.0, this.TestContext.CancellationToken) + +/// A value that holds dates and times of day: bare, optional and in a collection. +type Stay = { + Arrival : DateOnly + CheckIn : TimeOnly + Departure : DateOnly voption + Breakfasts : TimeOnly array +} + +/// An AutoGenConfig type whose every date is the last day of 1999. +type LastDayOf1999 = + static member __ = + AutoGenConfig.defaults + |> AutoGenConfig.addGenerator (Gen.constant (DateOnly (1999, 12, 31))) + +/// Properties with dates and times of day that no attribute bounds, run through the harness. +type DateAndTimeTargets () = + + [] + member _.``takes a date, a time of day and a value that holds them`` (_ : DateOnly, _ : TimeOnly, _ : Stay) = () + +/// Hedgehog 2.0.4 has no generator of DateOnly or TimeOnly. The adapter registers the two default generators that +/// hedgehogqa/fsharp-hedgehog#488 adds to Hedgehog, for the parameters of a property and until a release has them. +[] +type ``DateOnly and TimeOnly without an attribute tests`` () = + + let sample (size : int) : Gen<'T> -> 'T array = Gen.sample size 200 >> Seq.toArray + + [] + member _.``Hedgehog cannot generate a DateOnly or a TimeOnly by itself yet`` () = + // When this test fails, Hedgehog has the generators: AutoGenConfig.propertyDefaults of the adapter, which stands + // in for them, has to go together with this test. + Assert.Throws( + Action (fun () -> Gen.auto |> sample 50 |> ignore), + "Hedgehog generates a DateOnly by itself now, so the adapter need not register a generator for it." + ) + |> ignore + + Assert.Throws( + Action (fun () -> Gen.auto |> sample 50 |> ignore), + "Hedgehog generates a TimeOnly by itself now, so the adapter need not register a generator for it." + ) + |> ignore + + [] + member _.``a property with dates and times of day gets its arguments in every case`` () : Task = task { + let! run = Harness.runAsync "takes a date, a time of day and a value that holds them" + + Assert.AreEqual (Status.OK, run.Report.Status, "The dates and the times of day are generated.") + Assert.AreEqual (100, run.Report.Tests, "Every case gets its arguments.") + } + + [] + member _.``a date lies near 2000-01-01 in a small case and anywhere in a large one`` () = + let dates = Gen.autoWith AutoGenConfig.propertyDefaults + let origin = DateOnly (2000, 1, 1) + + Assert.DoesNotContain ( + (fun (date : DateOnly) -> abs (date.DayNumber - origin.DayNumber) > 31), + dates |> sample 10, + "A date of a small case lies within a month of 2000-01-01." + ) + + let large = dates |> sample 99 + Assert.Contains ((fun (date : DateOnly) -> date.Year < 1900), large, "Some of 200 dates lie before 1900.") + Assert.Contains ((fun (date : DateOnly) -> date.Year > 2100), large, "Some of 200 dates lie after 2100.") + + [] + member _.``a time of day lies later the larger a case is, anywhere in the day at full precision`` () = + let times = Gen.autoWith AutoGenConfig.propertyDefaults + + // A range that grew exponentially would keep the times of a case of this size within a moment of midnight + Assert.Contains ( + (fun (time : TimeOnly) -> time.Hour >= 1), + times |> sample 50, + "Some of 200 times of a medium case lie hours after midnight." + ) + + let large = times |> sample 99 + Assert.Contains ((fun (time : TimeOnly) -> time.Hour < 12), large, "Some of 200 times lie before noon.") + Assert.Contains ((fun (time : TimeOnly) -> time.Hour >= 12), large, "Some of 200 times lie after noon.") + + Assert.Contains ( + (fun (time : TimeOnly) -> time.Ticks % TimeSpan.TicksPerSecond <> 0L), + large, + "A time has the precision of TimeOnly, not whole seconds." + ) + + [)>] + member _.``a generator of the test's configuration wins`` (date : DateOnly, stay : Stay) = + Assert.AreEqual (DateOnly (1999, 12, 31), date, "The configuration of the test sets every date.") + Assert.AreEqual ( + DateOnly (1999, 12, 31), + stay.Arrival, + "The configuration of the test sets the dates inside a value too." + ) + + [)>] + member _.``a configuration without such generators keeps those of the adapter`` (i : int, _ : DateOnly, _ : TimeOnly) = + // The property fails with the error of the generator when a date or a time of day cannot be generated + Assert.AreEqual (2718, i, "The configuration of the test sets every int.") diff --git a/tests/Hedgehog.MSTest/AutoGenConfig.fs b/tests/Hedgehog.MSTest/AutoGenConfig.fs index 9a1d18a0..5525f4d9 100644 --- a/tests/Hedgehog.MSTest/AutoGenConfig.fs +++ b/tests/Hedgehog.MSTest/AutoGenConfig.fs @@ -10,7 +10,9 @@ // config method is found with the Seq.tryExactlyOne of this repository's collection helpers; the error for a type // without exactly one such method says "member" where upstream says "property", because a method that takes // AutoGenConfigArgs is accepted as well; the arguments may hold null, a null array of them counts as none where the -// attributes take it (argsOrNone), and a config method that returns no IAutoGenConfig is an error. +// attributes take it (argsOrNone), and a config method that returns no IAutoGenConfig is an error; propertyDefaults is +// added, the configuration that a property starts from, with the default generators of DateOnly and TimeOnly that +// Hedgehog 2.0.4 lacks. // The file is formatted with Fantomas, under the settings of this repository. namespace Hedgehog.MSTest @@ -18,11 +20,43 @@ namespace Hedgehog.MSTest open System open System.Reflection open Hedgehog +open Hedgehog.FSharp // For the collection functions of this repository that return a voption or struct tuples open FSharp.Azure.Cosmos module internal AutoGenConfig = + // Hedgehog 2.0.4 has no generator of DateOnly or TimeOnly: Gen.auto calls a constructor of the type with integers + // that it generates, and the constructor refuses them. hedgehogqa/fsharp-hedgehog#488 adds the two default + // generators below to Hedgehog itself, as DefaultGenerators.DateOnly and DefaultGenerators.TimeOnly: + // https://github.com/hedgehogqa/fsharp-hedgehog/pull/488 + // The adapter registers them for the parameters of a property until a release of Hedgehog has them. Then these + // three values go, and PropertyContext.defaults takes AutoGenConfig.defaults again; a test of the adapter's suite + // fails as soon as Hedgehog generates the two types by itself. + + // Dates around 2000-01-01, further away the larger a case is, up to any date at all + let private dateOnly : Gen = + Range.exponentialFrom (DateOnly (2000, 1, 1)).DayNumber DateOnly.MinValue.DayNumber DateOnly.MaxValue.DayNumber + |> Gen.int32 + |> Gen.map DateOnly.FromDayNumber + + // A linear range: an exponential one would keep the times of half of all sizes within the first tenth of a second + // after midnight, because a day has 864 billion ticks. + let private timeOnly : Gen = + Range.linear TimeOnly.MinValue.Ticks TimeOnly.MaxValue.Ticks + |> Gen.int64 + |> Gen.map TimeOnly + + /// + /// The configuration that a property starts from: and generators + /// of and . The configuration that a test names is + /// merged over it, so a generator of the test for one of the two types wins. + /// + let propertyDefaults : IAutoGenConfig = + AutoGenConfig.defaults + |> AutoGenConfig.addGenerator dateOnly + |> AutoGenConfig.addGenerator timeOnly + // Infers the generic arguments of a generic config method from the runtime types of the arguments it is given let private inferGenericArguments (configType : Type) (methodInfo : MethodInfo) (configArgs : objnull array) : Type array = let parameters = methodInfo.GetParameters () diff --git a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs index 990dbc5a..ae07f175 100644 --- a/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs +++ b/tests/Hedgehog.MSTest/GenAttribute.Prelude.fs @@ -379,8 +379,10 @@ type DateTimeOffsetAttribute /// /// /// The range is constant: it does not grow with the size of a case, and a value shrinks towards -/// . Upstream's adapters have no such attribute, and Hedgehog 2.0.4 cannot auto-generate a -/// , so a parameter of this type needs this attribute or a generator of its own. +/// . A parameter without this attribute gets a date around 2000-01-01, further away the larger +/// the case is. Upstream's adapters get this attribute and Hedgehog its generator of +/// through +/// hedgehogqa/fsharp-hedgehog#488. /// type DateOnlyAttribute /// @@ -419,9 +421,10 @@ type DateOnlyAttribute /// /// /// A value has the full precision of , 100 nanoseconds. The range is constant: it does -/// not grow with the size of a case, and a value shrinks towards . Upstream's adapters have no -/// such attribute, and Hedgehog 2.0.4 cannot auto-generate a , so a parameter of this -/// type needs this attribute or a generator of its own. +/// not grow with the size of a case, and a value shrinks towards . A parameter without this +/// attribute gets a time of the whole day, later the larger the case is. Upstream's adapters get this attribute and +/// Hedgehog its generator of through +/// hedgehogqa/fsharp-hedgehog#488. /// type TimeOnlyAttribute /// diff --git a/tests/Hedgehog.MSTest/PropertyContext.fs b/tests/Hedgehog.MSTest/PropertyContext.fs index e2adb155..cde0db79 100644 --- a/tests/Hedgehog.MSTest/PropertyContext.fs +++ b/tests/Hedgehog.MSTest/PropertyContext.fs @@ -6,7 +6,8 @@ // 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; a setting that is not given is a voption instead of an option, and the attributes are folded from -// a sequence expression instead of an appended list. +// a sequence expression instead of an appended list; a property starts from AutoGenConfig.propertyDefaults of this +// adapter instead of AutoGenConfig.defaults of Hedgehog. // The file is formatted with Fantomas, under the settings of this repository. namespace Hedgehog.MSTest @@ -30,7 +31,7 @@ type internal PropertyContext = { module internal PropertyContext = let defaults : PropertyContext = { - AutoGenConfig = AutoGenConfig.defaults + AutoGenConfig = AutoGenConfig.propertyDefaults Tests = ValueNone Shrinks = ValueNone Size = ValueNone From ffdc3ac3ae356b75ccdf0a629c7bd914ffe31911 Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Tue, 13 Oct 2026 02:17:40 +0100 Subject: [PATCH 7/8] chore(build): list the tests of every test application before running them A new DotnetListTests target, between DotnetBuild and DotnetTest in both build chains, lists the tests of every test application without running them (ADR 0001, section 22.1). MSTest 4 fails the discovery of a whole assembly when one test method has a signature it cannot run, such as a [] method that returns bool, while the F# build gives no warning; checked by adding such a method to the adapter's suite: the build succeeded without a warning, and the listing failed with UTA007 and exit code -532462766. Listing reports that before the run, which needs the emulator, starts. DotnetTest and DotnetListTests share dotnetTestApplications, which runs DotNet.testMTP of FAKE 6.2.0 without building, in the configuration of the executing targets, for every project that testsGlob matches, so the loop over the test applications is written once. The listing is the option ListTests. Co-Authored-By: Claude Opus 5.5 --- build/build.fs | 53 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 18 deletions(-) diff --git a/build/build.fs b/build/build.fs index 7d8b07f5..9ce91c44 100644 --- a/build/build.fs +++ b/build/build.fs @@ -354,32 +354,46 @@ let fsharpAnalyzers _ = dotnet.fsharpAnalyzer id args ) -let dotnetTest ctx = - // Create test results directory if it doesn't exist - Directory.create testResultsDir - +/// +/// Runs dotnet test with the Microsoft.Testing.Platform runner for every test application, without building, in +/// the configuration of the executing targets and with the options that changes. +/// +let dotnetTestApplications ctx (configure : DotNet.MTPTestOptions -> DotNet.MTPTestOptions) = let dotnetConfiguration = configuration (ctx.Context.AllExecutingTargets) !!testsGlob |> Seq.iter (fun testProject -> DotNet.testMTP - (fun options -> { - options with - NoBuild = true - Configuration = Some dotnetConfiguration - ResultsDirectory = if enableCodeCoverage then Some testResultsDir else None - CodeCoverage = - if enableCodeCoverage then - Some { - DotNet.MTPCodeCoverageOptions.Create () with - OutputFormat = Some DotNet.MTPCoverageFormat.Cobertura - } - else - None - }) + (fun options -> configure { options with NoBuild = true; Configuration = Some dotnetConfiguration }) (DotNet.MTPTestTarget.Project testProject) ) +let dotnetTest ctx = + // Create test results directory if it doesn't exist + Directory.create testResultsDir + + dotnetTestApplications + ctx + (fun options -> { + options with + ResultsDirectory = if enableCodeCoverage then Some testResultsDir else None + CodeCoverage = + if enableCodeCoverage then + Some { + DotNet.MTPCodeCoverageOptions.Create () with + OutputFormat = Some DotNet.MTPCoverageFormat.Cobertura + } + else + None + }) + +/// +/// 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 = dotnetTestApplications ctx (fun options -> { options with ListTests = true }) + let generateCoverageReport _ = let coverageFiles = @@ -640,6 +654,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 +716,7 @@ let initTargets (ctx : Context.FakeExecutionContext) = "DotnetRestore" =?> ("CheckFormatCode", isCI.Value) ==> "DotnetBuild" + ==> "DotnetListTests" ==> "DotnetTest" ==> "DotnetPack" ==> "PublishToNuGet" @@ -711,6 +727,7 @@ let initTargets (ctx : Context.FakeExecutionContext) = =?> ("CheckFormatCode", isCI.Value) =?> ("GenerateAssemblyInfo", isPublishToGitHub) ==> "DotnetBuild" + ==> "DotnetListTests" ==> "DotnetTest" ==> "DotnetPack" ==>! "PublishToGitHub" From df45d0098df301fff4fa7d611a018eae6440753f Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 3 Oct 2026 13:07:46 +0200 Subject: [PATCH 8/8] docs: document the Hedgehog MSTest adapter in the agent instructions The solution tree of the agent instructions lists tests/Hedgehog.MSTest and its suite, and the libraries list Hedgehog. The testing rules say how to write a property test: a method of a [] type marked [], with generated parameters, never Property.check inside a []; that it is an instance method that returns unit, Task or ValueTask and fails by throwing, because 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; that MSTest runs [] and [] for every generated case and every shrink step; and that a failure reports a [] that replays it; and that a DateOnly or TimeOnly parameter needs its generator attribute, because Hedgehog 2.0.4 cannot auto-generate these types. They also record that the adapter and its suite are the exception to the shared test infrastructure reference, the suite referencing the adapter alone, and that their code follows the rules of the file, formatting and nullness checking included, while the copy in the upstream pull request keeps upstream's style, with Apache-2.0 headers and THIRD-PARTY-NOTICES.md. Co-Authored-By: Claude Opus 5.5 --- .github/copilot-instructions.md | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/copilot-instructions.md b/.github/copilot-instructions.md index 46978db5..a487cb8e 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. A parameter of type `DateOnly` or `TimeOnly`, or of a type that holds one, is generated like any other, and `[]` and `[]` bound its value: Hedgehog 2.0.4 has no generator of the two types, so the adapter registers the ones that [hedgehogqa/fsharp-hedgehog#488](https://github.com/hedgehogqa/fsharp-hedgehog/pull/488) adds to Hedgehog, until a release has them. `Gen.auto` outside a property does not know the two types before that release. +* `tests/Hedgehog.MSTest` and `tests/Hedgehog.MSTest.Tests` are ported from hedgehogqa/fsharp-hedgehog and proposed there too ([hedgehogqa/fsharp-hedgehog#487](https://github.com/hedgehogqa/fsharp-hedgehog/pull/487)). Their code follows the rules of this file, formatting with Fantomas and nullness checking included; the copy in the upstream pull request keeps upstream's style, so a change of behaviour goes into both. Copied files keep their Apache-2.0 header, which records every change made to them, 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.