From 3864ff58207cf9e69efd9f1543276b9e836172e4 Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Fri, 2 Oct 2026 23:30:29 +0200 Subject: [PATCH 1/4] test: extract the shared test infrastructure project Move the code that later test projects will share out of tests/Cosmos.Tests into the library tests/Cosmos.Tests.Infrastructure (ADR 0001, section 5 and 22): the fixture and base classes (IntegrationInfrastructure.fs), the Assert and CosmosAssert helpers, the FakeFeedIterator/FakeFeedResponse fakes and the "Cosmos DB Emulator" category, which the emulator base class now carries as an attribute class instead of a string. The types keep their namespaces, so the tests compile unchanged; test-specific code (TestItem, OperationTestBase, scenarios, the per-operation categories) stays in the test project. The library sets IsTestProject=false and IsPackable=false explicitly and references MSTest.TestFramework only, never the MSTest metapackage. Central package management requires a PackageVersion for every PackageReference, so Directory.Packages.props lists MSTest.TestFramework next to MSTest; without it the restore of the library fails with NU1010. tests/Directory.Build.props references the library from every test project except itself. It is added to both FSharp.Azure.Cosmos.slnx and .slnf, testsGlob is narrowed to tests/**/*.Tests.??proj so `dotnet test` and `dotnet watch test` run only test applications, Clean still covers every project under tests/, and the coverage report excludes the infrastructure assembly. Every public member of the library is documented. The documentation refers to types, members and union cases through , FSharp.Core union cases by the documentation IDs FSharp.Core.xml documents them under (such as T:Microsoft.FSharp.Core.FSharpValueOption`1.ValueNone), the assertion families through one example pair each, and keeps for literal values. The F# compiler copies crefs verbatim and never resolves them, so they were checked against the built assemblies. Every tag sits on a line of its own, with the text wrapped at 120 characters without breaking inside a tag. In build.fs, the doc comments of testsGlob and of the ==>! and ?=>! operators follow the same rules. Co-Authored-By: Claude Opus 5.5 --- Directory.Packages.props | 1 + FSharp.Azure.Cosmos.slnf | 1 + FSharp.Azure.Cosmos.slnx | 1 + build/build.fs | 26 ++- tests/Cosmos.Tests.Infrastructure/Assert.fs | 136 +++++++++++++ .../CosmosAssert.fs | 178 ++++++++++++++++++ ...p.Azure.Cosmos.Tests.Infrastructure.fsproj | 35 ++++ tests/Cosmos.Tests.Infrastructure/FakeFeed.fs | 66 +++++++ .../IntegrationInfrastructure.fs | 69 ++++++- .../TestCategories.fs | 18 ++ tests/Cosmos.Tests/Assert.fs | 72 ------- .../FSharp.Azure.Cosmos.Tests.fsproj | 3 - .../IterationExtensionsUnitTests.fs | 40 ---- tests/Cosmos.Tests/TestCategories.fs | 6 +- tests/Directory.Build.props | 8 + 15 files changed, 532 insertions(+), 128 deletions(-) create mode 100644 tests/Cosmos.Tests.Infrastructure/Assert.fs rename tests/{Cosmos.Tests => Cosmos.Tests.Infrastructure}/CosmosAssert.fs (58%) create mode 100644 tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj create mode 100644 tests/Cosmos.Tests.Infrastructure/FakeFeed.fs rename tests/{Cosmos.Tests => Cosmos.Tests.Infrastructure}/IntegrationInfrastructure.fs (67%) create mode 100644 tests/Cosmos.Tests.Infrastructure/TestCategories.fs delete mode 100644 tests/Cosmos.Tests/Assert.fs diff --git a/Directory.Packages.props b/Directory.Packages.props index eed2274..cbda57a 100644 --- a/Directory.Packages.props +++ b/Directory.Packages.props @@ -26,6 +26,7 @@ + diff --git a/FSharp.Azure.Cosmos.slnf b/FSharp.Azure.Cosmos.slnf index f27072e..1a0488c 100644 --- a/FSharp.Azure.Cosmos.slnf +++ b/FSharp.Azure.Cosmos.slnf @@ -3,6 +3,7 @@ "path": "FSharp.Azure.Cosmos.slnx", "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" ] } diff --git a/FSharp.Azure.Cosmos.slnx b/FSharp.Azure.Cosmos.slnx index 4650bdc..4ec89bb 100644 --- a/FSharp.Azure.Cosmos.slnx +++ b/FSharp.Azure.Cosmos.slnx @@ -11,5 +11,6 @@ + diff --git a/build/build.fs b/build/build.fs index bdae51d..28b0425 100644 --- a/build/build.fs +++ b/build/build.fs @@ -42,9 +42,16 @@ let testsCodeGlob = let srcGlob = rootDirectory "src/**/*.??proj" -let testsGlob = rootDirectory "tests/**/*.??proj" +/// Every project under tests/, the helper libraries shared by the test projects included +let testsDirectoryGlob = rootDirectory "tests/**/*.??proj" -let srcAndTest = !!srcGlob ++ testsGlob +/// +/// The test applications only: helper libraries such as the test infrastructure do not end in .Tests, +/// so dotnet test and dotnet watch test never try to run them. +/// +let testsGlob = rootDirectory "tests/**/*.Tests.??proj" + +let srcAndTest = !!srcGlob ++ testsDirectoryGlob let distDir = rootDirectory "dist" @@ -246,7 +253,7 @@ let clean _ = [ "bin"; "temp"; distDir; coverageReportDir; testResultsDir ] |> Shell.cleanDirs - !!srcGlob ++ testsGlob + !!srcGlob ++ testsDirectoryGlob |> Seq.collect (fun p -> [ "bin"; "obj" ] |> Seq.map (fun sp -> IO.Path.GetDirectoryName p sp) @@ -394,8 +401,8 @@ let generateCoverageReport _ = sprintf "-targetdir:\"%s\"" coverageReportDir // Add source dir sprintf "-sourcedirs:\"%s\"" sourceDirs - // Ignore test assemblies - sprintf "-assemblyfilters:\"%s\"" "-*.Tests" + // Ignore test assemblies and the helper libraries they share + sprintf "-assemblyfilters:\"%s\"" "-*.Tests;-*.Tests.Infrastructure" // Generate HTML and Cobertura reports sprintf "-reporttypes:%s" "Html;Cobertura" ] @@ -615,10 +622,15 @@ let initTargets (ctx : Context.FakeExecutionContext) = && String.Equals (value, "PublishToGitHub", StringComparison.OrdinalIgnoreCase) ) - /// Defines a dependency - y is dependent on x. Finishes the chain. + /// + /// Defines a dependency - is dependent on . Finishes the chain. + /// let (==>!) x y = x ==> y |> ignore - /// Defines a soft dependency. x must run before y, if it is present, but y does not require x to be run. Finishes the chain. + /// + /// Defines a soft dependency. must run before , if it is present, but + /// does not require to be run. Finishes the chain. + /// let (?=>!) x y = x ?=> y |> ignore //----------------------------------------------------------------------------- // Hide Secrets in Logger diff --git a/tests/Cosmos.Tests.Infrastructure/Assert.fs b/tests/Cosmos.Tests.Infrastructure/Assert.fs new file mode 100644 index 0000000..6ba3e41 --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/Assert.fs @@ -0,0 +1,136 @@ +namespace FSharp.Azure.Cosmos.Tests + +open System.Runtime.InteropServices +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// +/// Assertions on F# , +/// and +/// values as extensions of . +/// +/// Assertions such as return the unwrapped value or fail the test; their twins such as +/// discard the value. +/// +/// +[] +module AssertExtensions = + + type Assert with + + /// + /// Returns the value of ; fails the test with + /// on . + /// + static member WantSome (value, [] message : string | null) = + match value with + | Some some -> some + | None -> + Assert.Fail (message) + Unchecked.defaultof<_> + + /// + /// Fails the test with unless is + /// . + /// + static member IsSome (value, [] message : string | null) = Assert.WantSome (value, message) |> ignore + + /// + /// Fails the test with unless is + /// . + /// + static member IsNone (value, [] message : string | null) = + match value with + | Some _ -> Assert.Fail (message) + | None -> () + + /// + /// Returns the value of ; fails the test + /// with on . + /// + static member WantValueSome (value, [] message : string | null) = + match value with + | ValueSome some -> some + | ValueNone -> + Assert.Fail (message) + Unchecked.defaultof<_> + + /// + /// Fails the test with unless is + /// . + /// + static member IsValueSome (value, [] message : string | null) = Assert.WantValueSome (value, message) |> ignore + + /// + /// Fails the test with unless is + /// . + /// + static member IsValueNone (value, [] message : string | null) = + match value with + | ValueSome _ -> Assert.Fail (message) + | ValueNone -> () + + /// + /// Returns the value of ; fails the test with + /// and the error on . + /// + static member WantOk (value, [] message : string | null) = + match value with + | Ok ok -> ok + | Error error -> + match message with + | null -> Assert.Fail (string error) + | message -> Assert.Fail ($"'{message}': {error}") + Unchecked.defaultof<_> + + /// + /// Fails the test with unless is + /// . + /// + static member IsOk (value, [] message : string | null) = Assert.WantOk (value, message) |> ignore + + /// + /// Returns the error of ; fails the test with + /// and the value on . + /// + static member WantError (value, [] message : string | null) = + match value with + | Error error -> error + | Ok value -> + match message with + | null -> Assert.Fail (string value) + | message -> Assert.Fail ($"'{message}': {value}") + Unchecked.defaultof<_> + + /// + /// Fails the test with unless is + /// . + /// + static member IsError (value, [] message : string | null) = Assert.WantError (value, message) |> ignore + + /// + /// Fails the test with unless is the default value of its + /// type. + /// + static member inline IsDefaultOf< ^T> (value : ^T, [] message : string) = + Assert.AreEqual (box value, box Unchecked.defaultof< ^T>, message) + + /// + /// Fails the test with unless is + /// holding . + /// + static member inline OkEquals< ^R, 'E> (expected : ^R, actual : Result< ^R, 'E >, [] message : string | null) = + Assert.AreEqual (box expected, box (Assert.WantOk (actual, message)), message) + + /// + /// Fails the test with unless is + /// holding . + /// + static member inline ErrorEquals<'R, ^E> (expected : ^E, actual : Result<'R, ^E>, [] message : string | null) = + Assert.AreEqual (box expected, box (Assert.WantError (actual, message)), message) + + /// + /// Fails the test with ; typed so that it can stand in for a value of any type. + /// + static member FailWithData<'T> ([] message : string | null) = + Assert.Fail (message) + Unchecked.defaultof<'T> diff --git a/tests/Cosmos.Tests/CosmosAssert.fs b/tests/Cosmos.Tests.Infrastructure/CosmosAssert.fs similarity index 58% rename from tests/Cosmos.Tests/CosmosAssert.fs rename to tests/Cosmos.Tests.Infrastructure/CosmosAssert.fs index 02fabd8..c1261a5 100644 --- a/tests/Cosmos.Tests/CosmosAssert.fs +++ b/tests/Cosmos.Tests.Infrastructure/CosmosAssert.fs @@ -13,6 +13,15 @@ open FSharp.Azure.Cosmos.Upsert open Microsoft.Azure.Cosmos open Microsoft.VisualStudio.TestTools.UnitTesting +/// +/// Assertions on the results of the operations of this library, such as , and on +/// . +/// +/// Assertions such as return the payload of the expected case or fail the test; their twins +/// such as discard the payload. Without a message, the failure names the expected and the +/// actual case. +/// +/// [] type CosmosAssert private () = @@ -22,6 +31,10 @@ type CosmosAssert private () = else message + /// + /// Returns the resource of an HTTP 200 or 201 ; fails the test with + /// on any other status. + /// static member WantOk<'T> (response : ItemResponse<'T>, [] message) = match response.StatusCode with | HttpStatusCode.OK @@ -30,8 +43,15 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected OK or Created but got {response.StatusCode}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless has HTTP status 200 or 201. + /// static member IsOk (response : ItemResponse<'T>, [] message) = CosmosAssert.WantOk (response, message) |> ignore + /// + /// Returns the payload of ; fails the test with on any + /// other case. + /// static member WantOk<'T> (result : CreateResult<'T>, [] message) = match result with | CreateResult.Ok ok -> ok @@ -39,8 +59,16 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected CreateResult.Ok but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsOk (result : CreateResult<'T>, [] message) = CosmosAssert.WantOk (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on any other + /// case. + /// static member WantOk<'T> (result : ReadResult<'T>, [] message) = match result with | ReadResult.Ok ok -> ok @@ -48,8 +76,15 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected ReadResult.Ok but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is . + /// static member IsOk (result : ReadResult<'T>, [] message) = CosmosAssert.WantOk (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on any + /// other case. + /// static member WantOk<'T> (result : ReplaceResult<'T>, [] message) = match result with | ReplaceResult.Ok ok -> ok @@ -57,8 +92,16 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected ReplaceResult.Ok but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsOk (result : ReplaceResult<'T>, [] message) = CosmosAssert.WantOk (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on any other + /// case. + /// static member WantOk<'T> (result : PatchResult<'T>, [] message) = match result with | PatchResult.Ok ok -> ok @@ -66,8 +109,15 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected PatchResult.Ok but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is . + /// static member IsOk (result : PatchResult<'T>, [] message) = CosmosAssert.WantOk (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on any + /// other case. + /// static member WantOk<'T> (result : UpsertResult<'T>, [] message) = match result with | UpsertResult.Ok ok -> ok @@ -75,8 +125,16 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected UpsertResult.Ok but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsOk (result : UpsertResult<'T>, [] message) = CosmosAssert.WantOk (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on any + /// other case. + /// static member WantOk<'T> (result : DeleteResult<'T>, [] message) = match result with | DeleteResult.Ok ok -> ok @@ -84,8 +142,16 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected DeleteResult.Ok but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsOk (result : DeleteResult<'T>, [] message) = CosmosAssert.WantOk (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on any + /// other case. + /// static member WantNotFound<'T> (result : ReadResult<'T>, [] message) = match result with | ReadResult.NotFound response -> response @@ -93,9 +159,17 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected ReadResult.NotFound but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsNotFound (result : ReadResult<'T>, [] message) = CosmosAssert.WantNotFound (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on + /// any other case. + /// static member WantNotFound<'T> (result : DeleteResult<'T>, [] message) = match result with | DeleteResult.NotFound response -> response @@ -103,9 +177,17 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected DeleteResult.NotFound but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsNotFound (result : DeleteResult<'T>, [] message) = CosmosAssert.WantNotFound (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on + /// any other case. + /// static member WantNotFound<'T> (result : ReplaceResult<'T>, [] message) = match result with | ReplaceResult.NotFound response -> response @@ -113,9 +195,17 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected ReplaceResult.NotFound but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsNotFound (result : ReplaceResult<'T>, [] message) = CosmosAssert.WantNotFound (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with on any + /// other case. + /// static member WantNotFound<'T> (result : PatchResult<'T>, [] message) = match result with | PatchResult.NotFound response -> response @@ -123,9 +213,17 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected PatchResult.NotFound but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsNotFound (result : PatchResult<'T>, [] message) = CosmosAssert.WantNotFound (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantModifiedBefore<'T> (result : UpsertResult<'T>, [] message) = match result with | UpsertResult.ModifiedBefore response -> response @@ -133,9 +231,17 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected UpsertResult.ModifiedBefore but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsModifiedBefore (result : UpsertResult<'T>, [] message) = CosmosAssert.WantModifiedBefore (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantModifiedBefore<'T> (result : ReplaceResult<'T>, [] message) = match result with | ReplaceResult.ModifiedBefore response -> response @@ -143,9 +249,17 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected ReplaceResult.ModifiedBefore but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsModifiedBefore (result : ReplaceResult<'T>, [] message) = CosmosAssert.WantModifiedBefore (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantModifiedBefore<'T> (result : PatchResult<'T>, [] message) = match result with | PatchResult.ModifiedBefore response -> response @@ -153,9 +267,17 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected PatchResult.ModifiedBefore but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsModifiedBefore (result : PatchResult<'T>, [] message) = CosmosAssert.WantModifiedBefore (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantModifiedBefore<'T> (result : DeleteResult<'T>, [] message) = match result with | DeleteResult.ModifiedBefore response -> response @@ -163,17 +285,33 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected DeleteResult.ModifiedBefore but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsModifiedBefore (result : DeleteResult<'T>, [] message) = CosmosAssert.WantModifiedBefore (result, message) |> ignore + /// + /// Fails the test with unless is + /// . + /// static member WantConflict (result : CreateResult<'T>, [] message) = match result with | CreateResult.IdAlreadyExists _ -> () | _ -> Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected CreateResult.IdAlreadyExists but got {result}.") + /// + /// Fails the test with unless is + /// . + /// static member IsConflict (result : CreateResult<'T>, [] message) = CosmosAssert.WantConflict (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantCustomError<'T, 'E> (result : UpsertConcurrentResult<'T, 'E>, [] message) = match result with | UpsertConcurrentResult.CustomError error -> error @@ -183,6 +321,10 @@ type CosmosAssert private () = ) Unchecked.defaultof<_> + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantCustomError<'T, 'E> (result : ReplaceConcurrentResult<'T, 'E>, [] message) = match result with | ReplaceConcurrentResult.CustomError error -> error @@ -192,6 +334,10 @@ type CosmosAssert private () = ) Unchecked.defaultof<_> + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantModifiedBefore<'T, 'E> (result : UpsertConcurrentResult<'T, 'E>, [] message) = match result with | UpsertConcurrentResult.ModifiedBefore response -> response @@ -201,9 +347,17 @@ type CosmosAssert private () = ) Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsModifiedBefore (result : UpsertConcurrentResult<'T, 'E>, [] message) = CosmosAssert.WantModifiedBefore (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantModifiedBefore<'T, 'E> (result : ReplaceConcurrentResult<'T, 'E>, [] message) = match result with | ReplaceConcurrentResult.ModifiedBefore response -> response @@ -213,9 +367,17 @@ type CosmosAssert private () = ) Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsModifiedBefore (result : ReplaceConcurrentResult<'T, 'E>, [] message) = CosmosAssert.WantModifiedBefore (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantCustomError<'T, 'E> (result : PatchConcurrentResult<'T, 'E>, [] message) = match result with | PatchConcurrentResult.CustomError error -> error @@ -223,6 +385,10 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected PatchConcurrentResult.CustomError but got {result}.") Unchecked.defaultof<_> + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantModifiedBefore<'T, 'E> (result : PatchConcurrentResult<'T, 'E>, [] message) = match result with | PatchConcurrentResult.ModifiedBefore response -> response @@ -232,9 +398,17 @@ type CosmosAssert private () = ) Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsModifiedBefore (result : PatchConcurrentResult<'T, 'E>, [] message) = CosmosAssert.WantModifiedBefore (result, message) |> ignore + /// + /// Returns the payload of ; fails the test with + /// on any other case. + /// static member WantNotFound<'T, 'E> (result : PatchConcurrentResult<'T, 'E>, [] message) = match result with | PatchConcurrentResult.NotFound response -> response @@ -242,5 +416,9 @@ type CosmosAssert private () = Assert.Fail (CosmosAssert.GetMessageOrDefault message $"Expected PatchConcurrentResult.NotFound but got {result}.") Unchecked.defaultof<_> + /// + /// Fails the test with unless is + /// . + /// static member IsNotFound (result : PatchConcurrentResult<'T, 'E>, [] message) = CosmosAssert.WantNotFound (result, message) |> ignore diff --git a/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj b/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj new file mode 100644 index 0000000..662708f --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj @@ -0,0 +1,35 @@ + + + + net10.0 + $(AssemblyBaseName).Tests.Infrastructure + true + + + false + false + + + + + + + + + + + + + + + + + + + + diff --git a/tests/Cosmos.Tests.Infrastructure/FakeFeed.fs b/tests/Cosmos.Tests.Infrastructure/FakeFeed.fs new file mode 100644 index 0000000..4033acf --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/FakeFeed.fs @@ -0,0 +1,66 @@ +namespace FSharp.Azure.Cosmos.Tests + +open System +open System.Net +open System.Threading +open System.Threading.Tasks +open Microsoft.Azure.Cosmos + +/// +/// A fake implementing the members and +/// declare abstract; only is actually read +/// by , the rest exist to satisfy the base classes. +/// +type FakeFeedResponse<'T> (items : 'T list) = + inherit FeedResponse<'T> () + + /// + override _.Count = items.Length + + /// + override _.ContinuationToken = null + + /// + override _.IndexMetrics = null + + /// + override _.GetEnumerator () = (items :> 'T seq).GetEnumerator() + + /// + override _.Headers = Headers () + + /// + override _.Resource = items :> 'T seq + + /// + override _.StatusCode = HttpStatusCode.OK + + /// + override _.Diagnostics = Unchecked.defaultof + +/// +/// A fake that serves a fixed sequence of pages without a Cosmos DB connection. +/// +type FakeFeedIterator<'T> (pages : 'T list list) = + inherit FeedIterator<'T> () + + let mutable remainingPages = pages + + /// + /// How many times has been called. + /// + member val ReadNextCallCount = 0 with get, set + + /// + override _.HasMoreResults = not remainingPages.IsEmpty + + /// + override this.ReadNextAsync (cancellationToken : CancellationToken) = + cancellationToken.ThrowIfCancellationRequested () + this.ReadNextCallCount <- this.ReadNextCallCount + 1 + + match remainingPages with + | [] -> raise (InvalidOperationException "ReadNextAsync called with no pages remaining.") + | page :: rest -> + remainingPages <- rest + Task.FromResult (FakeFeedResponse<'T>(page) :> FeedResponse<'T>) diff --git a/tests/Cosmos.Tests/IntegrationInfrastructure.fs b/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs similarity index 67% rename from tests/Cosmos.Tests/IntegrationInfrastructure.fs rename to tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs index afe345c..0387b0a 100644 --- a/tests/Cosmos.Tests/IntegrationInfrastructure.fs +++ b/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs @@ -10,11 +10,17 @@ open System.Threading.Tasks open Microsoft.Azure.Cosmos open Microsoft.VisualStudio.TestTools.UnitTesting +open FSharp.Azure.Cosmos.Tests + +/// Extensions of the MSTest test context used by the integration test fixtures. [] module TestContextExtensions = type TestContext with + /// + /// Builds the identifier of the database a test creates from the test name and its data row. + /// member ctx.GetTestDatabaseIdentifier () = match ctx.TestData with | null -> ctx.TestName @@ -36,13 +42,26 @@ module TestContextExtensions = $"{ctx.TestName}_{dataHash}" +/// +/// The base class of every test class: holds the MSTest injects. +/// [] type TestBase () = + /// + /// The context MSTest injects into the test class instance. + /// member val TestContext = Unchecked.defaultof with get, set + /// + /// The token MSTest cancels when the test times out or the run is aborted. + /// member this.CancellationToken = this.TestContext.CancellationTokenSource.Token +/// +/// The fixture of one emulator-backed test: a and a database of its own, created before the +/// test and deleted after it. Scenarios derive from it and override . +/// type DatabaseTestApplicationFactory (testContext : TestContext) = [] let endpoint = "https://127.0.0.1:8081" @@ -81,16 +100,34 @@ type DatabaseTestApplicationFactory (testContext : TestContext) = ) let mutable database = ValueNone + /// + /// The client connected to the emulator. + /// member _.Client = client + + /// + /// The identifier of the database this fixture creates. + /// member _.DatabaseId = databaseId + + /// + /// The database this fixture created; before + /// and after . + /// member _.Database = database + /// + /// Creates the database of this fixture. + /// member _.InitializeAsync (cancellationToken : CancellationToken) : Task = task { let! createdDatabase = client.CreateDatabaseIfNotExistsAsync (databaseId, cancellationToken = cancellationToken) database <- ValueSome createdDatabase.Database } + /// + /// Deletes the database of this fixture. + /// member _.CleanupAsync (cancellationToken : CancellationToken) : Task = task { match database with | ValueNone -> () @@ -99,6 +136,9 @@ type DatabaseTestApplicationFactory (testContext : TestContext) = database <- ValueNone } + /// + /// Creates a container in the database of this fixture unless it exists, and returns it. + /// member _.GetOrCreateContainerAsync (containerId : string, partitionKeyPath : string, cancellationToken : CancellationToken) : Task @@ -117,10 +157,14 @@ type DatabaseTestApplicationFactory (testContext : TestContext) = return containerResponse.Container } + /// + /// Seeds the data of a scenario after the database is created; does nothing unless overridden. + /// abstract SeedDataAsync : cancellationToken : CancellationToken -> Task default _.SeedDataAsync (cancellationToken : CancellationToken) = Task.CompletedTask interface IAsyncDisposable with + /// member this.DisposeAsync () = task { try @@ -130,7 +174,12 @@ type DatabaseTestApplicationFactory (testContext : TestContext) = } |> ValueTask -[] +/// +/// The base class of emulator-backed test classes: creates the fixture of every test, a +/// , in its method and disposes it in +/// its method. +/// +[] type IntegrationTestBase<'DatabaseTestApplicationFactory when 'DatabaseTestApplicationFactory :> DatabaseTestApplicationFactory> () = @@ -138,13 +187,24 @@ type IntegrationTestBase<'DatabaseTestApplicationFactory when 'DatabaseTestAppli member val private application : 'DatabaseTestApplicationFactory voption = ValueNone with get, set + /// + /// The fixture of the running test. + /// member this.Application = match this.application with | ValueNone -> invalidOp "Application not initialized. Ensure test runs within TestInitialize/TestCleanup lifecycle." | ValueSome application -> application + /// + /// Creates the fixture of the running test. + /// abstract CreateApplication : TestContext -> 'DatabaseTestApplicationFactory + /// + /// Creates the fixture through , its database through + /// and the data of its scenario through + /// . + /// [] member this.Initialize () : Task = task { let application = this.CreateApplication (this.TestContext) @@ -153,6 +213,9 @@ type IntegrationTestBase<'DatabaseTestApplicationFactory when 'DatabaseTestAppli do! application.SeedDataAsync (this.CancellationToken) } + /// + /// Disposes , deleting its database. + /// [] member this.Cleanup () : Task = task { match this.application with @@ -162,7 +225,11 @@ type IntegrationTestBase<'DatabaseTestApplicationFactory when 'DatabaseTestAppli this.application <- ValueNone } +/// +/// The base class of emulator-backed test classes that need no scenario: an empty database per test. +/// type IntegrationTestBase () = inherit IntegrationTestBase () + /// override _.CreateApplication context = DatabaseTestApplicationFactory (context) diff --git a/tests/Cosmos.Tests.Infrastructure/TestCategories.fs b/tests/Cosmos.Tests.Infrastructure/TestCategories.fs new file mode 100644 index 0000000..5bbcfd9 --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/TestCategories.fs @@ -0,0 +1,18 @@ +// The test categories every test project shares. A category attribute class rather than a string constant, so it is +// self-sufficient: --filter TestCategory=... picks its TestCategories up exactly like []'s. Categories of +// one test project's own operations and components stay in that project. +namespace FSharp.Azure.Cosmos.Tests + +open System.Collections.Generic +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// +/// Categorizes a test as needing the Cosmos DB Emulator. +/// carries it, so every class derived from +/// it inherits it. +/// +type CosmosDbEmulatorTestCategoryAttribute () = + inherit TestCategoryBaseAttribute () + + /// + override _.TestCategories = [| "Cosmos DB Emulator" |] :> IList diff --git a/tests/Cosmos.Tests/Assert.fs b/tests/Cosmos.Tests/Assert.fs deleted file mode 100644 index 7c6e450..0000000 --- a/tests/Cosmos.Tests/Assert.fs +++ /dev/null @@ -1,72 +0,0 @@ -namespace FSharp.Azure.Cosmos.Tests - -open System.Runtime.InteropServices -open Microsoft.VisualStudio.TestTools.UnitTesting - -[] -module AssertExtensions = - - type Assert with - - static member WantSome (value, [] message : string | null) = - match value with - | Some some -> some - | None -> - Assert.Fail (message) - Unchecked.defaultof<_> - - static member IsSome (value, [] message : string | null) = Assert.WantSome (value, message) |> ignore - - static member IsNone (value, [] message : string | null) = - match value with - | Some _ -> Assert.Fail (message) - | None -> () - - static member WantValueSome (value, [] message : string | null) = - match value with - | ValueSome some -> some - | ValueNone -> - Assert.Fail (message) - Unchecked.defaultof<_> - - static member IsValueSome (value, [] message : string | null) = Assert.WantValueSome (value, message) |> ignore - - static member IsValueNone (value, [] message : string | null) = - match value with - | ValueSome _ -> Assert.Fail (message) - | ValueNone -> () - - static member WantOk (value, [] message : string | null) = - match value with - | Ok ok -> ok - | Error error -> - match message with - | null -> Assert.Fail (string error) - | message -> Assert.Fail ($"'{message}': {error}") - Unchecked.defaultof<_> - - static member IsOk (value, [] message : string | null) = Assert.WantOk (value, message) |> ignore - - static member WantError (value, [] message : string | null) = - match value with - | Error error -> error - | Ok value -> - match message with - | null -> Assert.Fail (string value) - | message -> Assert.Fail ($"'{message}': {value}") - Unchecked.defaultof<_> - - static member IsError (value, [] message : string | null) = Assert.WantError (value, message) |> ignore - - static member inline IsDefaultOf< ^T> (value : ^T, [] message : string) = - Assert.AreEqual (box value, box Unchecked.defaultof< ^T>, message) - - static member inline OkEquals< ^R, 'E> (expected : ^R, actual : Result< ^R, 'E >, [] message : string | null) = - Assert.AreEqual (box expected, box (Assert.WantOk (actual, message)), message) - - static member inline ErrorEquals<'R, ^E> (expected : ^E, actual : Result<'R, ^E>, [] message : string | null) = - Assert.AreEqual (box expected, box (Assert.WantError (actual, message)), message) - - static member FailWithData<'T> ([] message : string | null) = - Assert.Fail (message) - Unchecked.defaultof<'T> diff --git a/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj b/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj index 4f42acf..fc2e29c 100644 --- a/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj +++ b/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj @@ -21,9 +21,6 @@ - - - diff --git a/tests/Cosmos.Tests/IterationExtensionsUnitTests.fs b/tests/Cosmos.Tests/IterationExtensionsUnitTests.fs index 2ed8935..4dadafd 100644 --- a/tests/Cosmos.Tests/IterationExtensionsUnitTests.fs +++ b/tests/Cosmos.Tests/IterationExtensionsUnitTests.fs @@ -2,52 +2,12 @@ namespace FSharp.Azure.Cosmos.Tests open System open System.Collections.Generic -open System.Net open System.Threading open System.Threading.Tasks open FSharp.Control open Microsoft.Azure.Cosmos open Microsoft.VisualStudio.TestTools.UnitTesting -/// -/// A fake implementing the members and -/// declare abstract; only is actually read -/// by , the rest exist to satisfy the base classes. -/// -type private FakeFeedResponse<'T> (items : 'T list) = - inherit FeedResponse<'T> () - - override _.Count = items.Length - override _.ContinuationToken = null - override _.IndexMetrics = null - override _.GetEnumerator () = (items :> 'T seq).GetEnumerator() - override _.Headers = Headers () - override _.Resource = items :> 'T seq - override _.StatusCode = HttpStatusCode.OK - override _.Diagnostics = Unchecked.defaultof - -/// -/// A fake that serves a fixed sequence of pages without a Cosmos DB connection. -/// -type private FakeFeedIterator<'T> (pages : 'T list list) = - inherit FeedIterator<'T> () - - let mutable remainingPages = pages - - member val ReadNextCallCount = 0 with get, set - - override _.HasMoreResults = not remainingPages.IsEmpty - - override this.ReadNextAsync (cancellationToken : CancellationToken) = - cancellationToken.ThrowIfCancellationRequested () - this.ReadNextCallCount <- this.ReadNextCallCount + 1 - - match remainingPages with - | [] -> raise (InvalidOperationException "ReadNextAsync called with no pages remaining.") - | page :: rest -> - remainingPages <- rest - Task.FromResult (FakeFeedResponse<'T>(page) :> FeedResponse<'T>) - /// /// Regression coverage for the hand-written : it replaced a /// taskSeq { } implementation that threw in Debug builds, so these tests diff --git a/tests/Cosmos.Tests/TestCategories.fs b/tests/Cosmos.Tests/TestCategories.fs index 31fbf72..53bc6bd 100644 --- a/tests/Cosmos.Tests/TestCategories.fs +++ b/tests/Cosmos.Tests/TestCategories.fs @@ -2,6 +2,7 @@ // component, in the same order as the string constants they replace used to be declared in. An abstract // MSTest attribute whose TestCategories list is picked up by --filter TestCategory=... exactly like // []'s, but self-sufficient: no separate string constant needed to know what to pass it. +// The categories every test project shares, such as the Cosmos DB Emulator one, live in the test infrastructure project. namespace FSharp.Azure.Cosmos.Tests open System.Collections.Generic @@ -55,11 +56,6 @@ type ValidationTestCategoryAttribute () = inherit TestCategoryBaseAttribute () override _.TestCategories = [| "Validation" |] :> IList -/// Categorizes a test as needing the Cosmos DB Emulator, the way the shared integration test base class does. -type CosmosDbEmulatorTestCategoryAttribute () = - inherit TestCategoryBaseAttribute () - override _.TestCategories = [| "Cosmos DB Emulator" |] :> IList - /// /// Categorizes as both a fast, emulator-free unit test and coverage for the /// iteration extensions: and diff --git a/tests/Directory.Build.props b/tests/Directory.Build.props index e7a7266..73f3282 100644 --- a/tests/Directory.Build.props +++ b/tests/Directory.Build.props @@ -4,4 +4,12 @@ false true + + + + + From 1875924d56db58f5adaa125be6877a1ae07009c0 Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Fri, 2 Oct 2026 23:37:56 +0200 Subject: [PATCH 2/4] test: name test databases stably and sweep leftovers Replace the database identifier of the integration fixtures with the algorithm of ADR 0001 section 22.3, in the DatabaseIdentifier module. The identity of a test is the TestIdentity struct record: the fully qualified class name; the test name, read from TestContext.Properties["TestName"] and ValueNone in class-level contexts, where TestContext.TestName throws; the data row, a nullable array of nullable objects as TestContext.TestData declares it; and the display name of the row. Each field is documented on the field itself. An identifier is the common prefix fsac-test-, a short hash of the class name and the test name together, separated by a line break, which occurs in neither, and the readable test name, in which the characters of an explicit, platform-independent set (the / \ ? # Cosmos DB forbids, the other characters Windows forbids in file names, % and whitespace) become _ and which is cut to fit 80 characters. The readable name alone does not tell tests apart: equally named methods of two classes share it, and so do names such as "a/b", "a b" and "a_b" or names that differ only beyond the cut, and parallel tests that share a database delete it under each other. The hash does tell them apart, so a cut name needs no hash of its own. A class-level identifier hashes the class name alone and has its own separator. A data-driven test gets a hash of its row appended. The row is encoded unambiguously before it is hashed: every value is written as the name of its runtime type followed by its text, each with its length in front; the items of a sequence are encoded the same way and framed as a whole, null is an empty type name, and the display name follows the values. So 1 as int and 1L as int64 get different databases. The type name comes from Type.ToString rather than Type.FullName, whose generic arguments carry assembly versions that would change the identifier with the runtime. What remains ambiguous, two values of one type whose text is equal and two types of one full name from different assemblies, is documented along with why it is acceptable. Every hash is SHA-256 over the UTF-16 code units of its text in little-endian order: not String.GetHashCode, which is randomised per process, and not UTF-8, which replaces every lone surrogate by U+FFFD. The endpoint and key come from COSMOS_EMULATOR_ENDPOINT and COSMOS_EMULATOR_KEY when set, with the documented emulator values as defaults; the client keeps Gateway mode and the HTTP client that accepts the self-signed certificate from local hosts only. They live in Emulator, a top-level module. An [] and an [] hook sweep leftover databases: those with the prefix that stayed unmodified for the leftover age, read from _ts through DatabaseProperties.LastModified. The prefix cannot tell test processes apart, but the age can: a test keeps its database only while it runs, so the sweep keeps the live databases of another test process on the same emulator, such as another clone, a CI agent or a parallel branch. The age is 60 minutes by default, overridden in whole minutes by COSMOS_TEST_LEFTOVER_AGE_MINUTES, where 0 sweeps every test database, for a run that has the emulator to itself. A database modified after the sweep began or reported without _ts is kept, and the kept ones are counted in the TestContext. A malformed variable skips the sweep instead of guessing, and so does an emulator that does not answer, so emulator-free test runs are not slowed down. Failures are written to the TestContext and never fail the run. A test still deletes its own database in its cleanup, whatever its age. Since the sweep keeps young databases and identifiers are stable, a rerun of a test whose earlier run was aborted, or whose cleanup failed, meets the old database with its containers and items, and a scenario seed then fails with a conflict on an item the earlier run created (reproduced with ReadOperationIntegrationTests against a planted database). The fixture therefore recreates its database when CreateDatabaseIfNotExistsAsync reports that it existed already and writes that to the TestContext, so every test starts with an empty database and the old containers free their partitions. A normal run, where the database is new, makes no extra request. Emulator-free unit tests cover the identifier, with expected values computed independently in PowerShell from the documented format, and the decision of the sweep, Emulator.isLeftover, a pure function over the minimum age, the moment of the sweep and the last modification, together with the conversion of _ts into an instant. Co-Authored-By: Claude Opus 5.5 --- .../DatabaseIdentifier.fs | 218 ++++++++++++++++ tests/Cosmos.Tests.Infrastructure/Emulator.fs | 241 ++++++++++++++++++ ...p.Azure.Cosmos.Tests.Infrastructure.fsproj | 2 + .../IntegrationInfrastructure.fs | 90 ++----- tests/Cosmos.Tests/DatabaseIdentifierTests.fs | 195 ++++++++++++++ .../FSharp.Azure.Cosmos.Tests.fsproj | 3 + tests/Cosmos.Tests/LeftoverSweepTests.fs | 80 ++++++ tests/Cosmos.Tests/TestAssembly.fs | 42 +++ tests/Cosmos.Tests/TestCategories.fs | 8 + 9 files changed, 808 insertions(+), 71 deletions(-) create mode 100644 tests/Cosmos.Tests.Infrastructure/DatabaseIdentifier.fs create mode 100644 tests/Cosmos.Tests.Infrastructure/Emulator.fs create mode 100644 tests/Cosmos.Tests/DatabaseIdentifierTests.fs create mode 100644 tests/Cosmos.Tests/LeftoverSweepTests.fs create mode 100644 tests/Cosmos.Tests/TestAssembly.fs diff --git a/tests/Cosmos.Tests.Infrastructure/DatabaseIdentifier.fs b/tests/Cosmos.Tests.Infrastructure/DatabaseIdentifier.fs new file mode 100644 index 0000000..f7ad0de --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/DatabaseIdentifier.fs @@ -0,0 +1,218 @@ +namespace FSharp.Azure.Cosmos.Tests.Integration + +open System +open System.Buffers +open System.Buffers.Binary +open System.Collections +open System.Globalization +open System.Security.Cryptography +open System.Text + +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// +/// The identity of a test, from which builds the identifier of its database. +/// +[] +type TestIdentity = { + /// + /// The fully qualified name of the test class. + /// + ClassName : string + + /// + /// The test method name; in a class-level + /// context such as a method, where the whole class shares one database named + /// after the class. + /// + TestName : string voption + + /// + /// The data row of a data-driven test; otherwise. + /// + TestData : objnull array | null + + /// + /// The display name of the data row; when it has none. + /// + DisplayName : string | null +} + +/// +/// Builds the identifier of the database an emulator-backed test creates. +/// +/// An identifier reads fsac-test-<test hash>_<test name>: , a short stable hash +/// of together with , and +/// with every invalid character replaced by _. A data-driven test gets +/// _<row hash> appended, a stable hash of and +/// . A name that does not fit into is cut. +/// +/// +/// The readable test name alone does not tell two tests apart: equally named methods of two classes share it, and so do +/// two methods of one class whose names differ only in characters that are replaced, such as a/b, a b and +/// a_b, or only beyond the cut. The test hash covers the unchanged class and test names, so none of them share +/// a database. +/// +/// +/// The row hash covers an encoding of the row in which every value is written as the name of its runtime type followed +/// by its text, each with its length in front. The text of a string is the string itself, that of an +/// value its invariant text, that of an its items encoded the same +/// way, and that of any other value its . The display name of the row follows its +/// values. Values of two types that read alike, such as 1 as an and as an +/// , therefore never share a row hash, and no text reads like several values or like a nested +/// array. +/// +/// +/// What remains ambiguous are values whose type names and texts are both equal: two values of one type whose text is +/// equal, such as two objects that do not override or two +/// values naming types of one full name from different assemblies, and values of two such types. That is acceptable: +/// the arguments of a are constants of primitive types, , +/// enumerations, and arrays of them, whose invariant text differs for any two values of one type +/// unless they name types of one full name, and rows that a provides with such +/// values still get different identifiers when their display names differ, as MSTest needs them to differ to report +/// the rows apart. +/// +/// +/// Every hash is SHA-256 based rather than , which is randomised per process: +/// a rerun of an aborted test meets the database that run left behind and recreates it instead of adding another one, +/// and the leftover sweep, , finds it by . +/// +/// +[] +module DatabaseIdentifier = + + /// + /// The prefix of every test database identifier, by which finds + /// leftover test databases. + /// + [] + let Prefix = "fsac-test-" + + /// + /// The maximum length of an identifier. + /// + [] + let MaxLength = 80 + + // Eight hex digits (32 bits) keep a collision among a few thousand tests or rows of one method negligible + [] + let private HashLength = 8 + + // An explicit set, because Path.GetInvalidFileNameChars differs per platform and contains no '#'. + // '/', '\', '?' and '#' are the characters Cosmos DB forbids in resource identifiers; '"', '<', '>', '|', ':' and '*' + // are the other characters Windows forbids in file names; '%' would be read as an escape in REST resource links. + let private invalidCharacters = SearchValues.Create "/\\?#\"<>|:*%" + + let private isInvalid (character : char) = + // Whitespace as well: Cosmos DB forbids a trailing space, which cutting a long name could leave behind + Char.IsWhiteSpace character + || Char.IsControl character + || invalidCharacters.Contains character + + let private sanitize (name : string) = + name + |> String.map (fun character -> if isInvalid character then '_' else character) + + let private stableHash (text : string) = + // The UTF-16 code units of the text rather than its UTF-8 bytes: UTF-8 replaces every lone surrogate by U+FFFD, + // so two texts that differ only in lone surrogates would hash alike. Little-endian on every machine, so that the + // hash does not depend on where the test runs. + let bytes = Array.zeroCreate(text.Length * sizeof) + + for index in 0 .. text.Length - 1 do + BinaryPrimitives.WriteUInt16LittleEndian (bytes.AsSpan (index * sizeof), uint16 text[index]) + + let hash = SHA256.HashData bytes + Convert.ToHexStringLower (hash, 0, HashLength / 2) + + // Writes the length of the text in front of it, so that the text ends where its length says, whatever it contains + let private appendFramed (builder : StringBuilder) (text : string) = + builder.Append(text.Length.ToString (CultureInfo.InvariantCulture)).Append(':').Append(text) + |> ignore + + // Writes the runtime type of the value, then its text, both framed. The type tells apart values that read alike, such + // as 1 and 1L; the type decides how the text is written, so equal type names always come with texts written alike. + let rec private appendValue (builder : StringBuilder) (value : objnull) = + match value with + // An empty type name, which no runtime type has + | null -> appendFramed builder "" + | value -> + // Type.ToString rather than Type.FullName: the full name of a generic type qualifies its type arguments with + // their assemblies and versions, so the identifier would change with the runtime version + appendFramed builder (value.GetType().ToString()) + + match value with + | :? string as text -> appendFramed builder text + | :? IFormattable as formattable -> appendFramed builder (formattable.ToString (null, CultureInfo.InvariantCulture)) + | :? IEnumerable as items -> + // The items framed as a whole, so that the items of a nested sequence never read like those of the outer one + let itemsBuilder = StringBuilder () + + for item in items do + appendValue itemsBuilder item + + appendFramed builder (itemsBuilder.ToString ()) + | value -> + match value.ToString () with + | null -> appendFramed builder "" + | text -> appendFramed builder text + + let private dataRowHash (testData : objnull array) (displayName : string | null) = + let encoding = StringBuilder () + appendValue encoding testData + // The display name as well, so that rows whose values encode alike still get different hashes when their display + // names differ, such as rows of objects that do not override ToString + appendValue encoding displayName + stableHash (encoding.ToString ()) + + /// + /// Builds the database identifier of the test that identifies. + /// + /// The identity of the test. + /// An identifier of at most characters that Cosmos DB accepts. + let create (test : TestIdentity) : string = + let struct (name, separator, hashedName) = + match test.TestName with + // A line break never occurs in a class or method name, so no other pair of names hashes the same text + | ValueSome testName -> struct (testName, '_', $"{test.ClassName}\n{testName}") + // A different separator keeps the class database apart from the one of a method named like its class + | ValueNone -> struct (test.ClassName.Substring (test.ClassName.LastIndexOf '.' + 1), '-', test.ClassName) + + let rowSuffix = + match test.TestData with + | null -> "" + | testData -> $"_{dataRowHash testData test.DisplayName}" + + let head = $"{Prefix}{stableHash hashedName}{separator}" + let room = MaxLength - head.Length - rowSuffix.Length + let readableName = sanitize name + + let readableName = + if readableName.Length <= room then + readableName + else + // No further hash needed: the one in the head already tells apart names that differ only beyond the cut + readableName.Substring (0, room) + + $"{head}{readableName}{rowSuffix}" + + /// + /// Builds the database identifier of the test that describes. + /// + /// + /// The test name is read from , because + /// throws in class-level contexts; there the identifier falls back to + /// . + /// + let ofTestContext (testContext : TestContext) : string = + let testName = + match testContext.Properties.TryGetValue "TestName" with + | true, (:? string as testName) -> ValueSome testName + | _ -> ValueNone + + create { + ClassName = testContext.FullyQualifiedTestClassName + TestName = testName + TestData = testContext.TestData + DisplayName = testContext.TestDisplayName + } diff --git a/tests/Cosmos.Tests.Infrastructure/Emulator.fs b/tests/Cosmos.Tests.Infrastructure/Emulator.fs new file mode 100644 index 0000000..6909e2e --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/Emulator.fs @@ -0,0 +1,241 @@ +/// +/// The Cosmos DB Emulator the tests run against: its connection settings, , which creates the +/// client of every , and , which +/// sweeps the test databases left behind. +/// +[] +module FSharp.Azure.Cosmos.Tests.Integration.Emulator + +open System +open System.Globalization +open System.Net.Http +open System.Net.Security +open System.Threading +open System.Threading.Tasks + +open Microsoft.Azure.Cosmos +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// +/// The environment variable that overrides . +/// +[] +let EndpointVariable = "COSMOS_EMULATOR_ENDPOINT" + +/// +/// The environment variable that overrides . +/// +[] +let KeyVariable = "COSMOS_EMULATOR_KEY" + +/// +/// The documented endpoint of a local emulator. +/// +[] +let DefaultEndpoint = "https://127.0.0.1:8081" + +/// +/// The documented, publicly known primary key of the emulator. +/// +[] +let DefaultKey = + "C2y6yDjf5/R+ob0N8A7Cgv30VRDJIWEHLM+4QDU5DE2nQ9nDuVTqobD4b8mGGyPMbIZnqyMsEcaGQy67XIw/Jw==" + +let private readVariable (name : string) = + match Environment.GetEnvironmentVariable name with + | null -> ValueNone + | value when String.IsNullOrWhiteSpace value -> ValueNone + | value -> ValueSome (value.Trim ()) + +/// +/// The endpoint the tests connect to: the value of when it is set, so that the same +/// tests run against another emulator, otherwise . +/// +let endpoint = + readVariable EndpointVariable + |> ValueOption.defaultValue DefaultEndpoint + +/// +/// The key the tests authenticate with: the value of when it is set, otherwise +/// . +/// +let key = + readVariable KeyVariable + |> ValueOption.defaultValue DefaultKey + +/// +/// The environment variable that overrides . +/// +[] +let LeftoverAgeVariable = "COSMOS_TEST_LEFTOVER_AGE_MINUTES" + +/// +/// How many minutes a test database must stay unmodified before deletes it +/// by default: far longer than any test keeps its database, so that the sweep keeps the live databases of other test +/// processes. +/// +[] +let DefaultLeftoverAgeMinutes = 60 + +/// +/// Reads how long a test database must stay unmodified before deletes it: +/// the value of in whole minutes when it is set, otherwise +/// . 0 makes the sweep delete every test database, which is safe only +/// while no other test process uses the emulator. +/// +/// +/// is set to something other than a non-negative integer. +/// +let readLeftoverAge () : TimeSpan = + match readVariable LeftoverAgeVariable with + | ValueNone -> TimeSpan.FromMinutes (float DefaultLeftoverAgeMinutes) + | ValueSome text -> + match Int32.TryParse (text, NumberStyles.None, CultureInfo.InvariantCulture) with + | true, minutes -> TimeSpan.FromMinutes (float minutes) + | _ -> invalidOp $"{LeftoverAgeVariable} must be a non-negative whole number of minutes, but it is '{text}'." + +/// +/// Reads when was modified last from , its +/// _ts system property in seconds since the Unix epoch; +/// when the emulator does not report it. +/// +let lastModifiedOf (database : DatabaseProperties) : DateTimeOffset voption = + database.LastModified + |> ValueOption.ofNullable + // _ts is UTC by definition and the SDK reads it into a DateTime of kind Utc. Setting the kind anyway keeps the + // DateTimeOffset constructor from taking an Unspecified one for local time, which would shift it by the offset. + |> ValueOption.map (fun lastModified -> DateTimeOffset (DateTime.SpecifyKind (lastModified, DateTimeKind.Utc))) + +/// +/// Decides whether a test database is old enough to be a leftover that +/// deletes: whether it stayed unmodified for at least before . +/// +/// +/// A database modified after , such as one created while the sweep lists the databases, is never +/// a leftover, not even with a zero . The decision trusts the emulator's clock, which +/// stamps , to agree with this machine's within . +/// +/// How long the database must stay unmodified; see . +/// The moment of the sweep. +/// When the database was modified last; see . +let isLeftover (minimumAge : TimeSpan) (now : DateTimeOffset) (lastModified : DateTimeOffset) : bool = + let age = now - lastModified + age >= TimeSpan.Zero && age >= minimumAge + +let private isLocalEmulatorHost (uri : Uri) = + uri.Host.Equals ("localhost", StringComparison.OrdinalIgnoreCase) + || uri.Host.Equals ("127.0.0.1", StringComparison.OrdinalIgnoreCase) + +// The emulator serves a self-signed certificate; it is accepted from local hosts only +let private createHttpMessageHandler () = + new HttpClientHandler ( + ServerCertificateCustomValidationCallback = + (fun request _ _ errors -> + match request.RequestUri with + | null -> errors = SslPolicyErrors.None + | requestUri when errors = SslPolicyErrors.None -> true + | requestUri -> isLocalEmulatorHost requestUri + ) + ) + +/// +/// Creates a for the emulator in mode, the only mode +/// the Linux vNext emulator serves, whose accepts the emulator's self-signed certificate from +/// local hosts only. +/// +let createClient () : CosmosClient = + new CosmosClient ( + endpoint, + key, + CosmosClientOptions ( + ConnectionMode = ConnectionMode.Gateway, + HttpClientFactory = Func(fun () -> new HttpClient (createHttpMessageHandler (), true)) + ) + ) + +// How long the sweep waits for an answer before it concludes that no emulator runs. Without this check, a run of +// the unit tests alone on a machine without an emulator would wait for the SDK to give up (seconds per request). +let private reachabilityTimeout = TimeSpan.FromSeconds 5.0 + +let private isReachableAsync (cancellationToken : CancellationToken) : Task = task { + use httpClient = new HttpClient (createHttpMessageHandler (), true, Timeout = reachabilityTimeout) + + try + // Any HTTP answer will do: an unauthenticated request to the root returns 401 once the emulator is up + use! response = httpClient.GetAsync (endpoint, cancellationToken) + return true + with + | :? HttpRequestException -> return false + | :? TaskCanceledException when not cancellationToken.IsCancellationRequested -> return false +} + +/// +/// Deletes the databases whose identifier starts with and that stayed +/// unmodified for at least the leftover age (): databases of tests whose cleanup failed +/// and of runs that were aborted, which would otherwise keep their containers' partitions. +/// +/// +/// +/// The prefix does not tell test processes apart, the age does: a younger test database may be the live database of +/// another test process that uses the same emulator, such as another clone, a CI agent or a parallel branch, so it +/// is kept, and so is one whose age the emulator does not report. A test does not leave its own database to the +/// sweep: it deletes it in . +/// +/// +/// Best-effort: every failure is written to and none fails the run. A malformed +/// skips the sweep rather than guessing an age. When the emulator does not answer, +/// the sweep is skipped as well, so that tests that need no emulator still run without one. +/// +/// +let deleteLeftoverDatabasesAsync (testContext : TestContext) : Task = task { + let cancellationToken = testContext.CancellationToken + + let minimumAge = + try + ValueSome (readLeftoverAge ()) + with :? InvalidOperationException as ex -> + testContext.WriteLine $"Leftover test databases are not swept: {ex.Message}" + ValueNone + + match minimumAge with + | ValueNone -> () + | ValueSome minimumAge -> + let! reachable = isReachableAsync cancellationToken + + if not reachable then + testContext.WriteLine + $"The Cosmos DB Emulator at {endpoint} does not answer, so leftover test databases are not swept." + else + use client = createClient () + let leftovers = ResizeArray() + let mutable keptCount = 0 + // Taken before the listing, so that a database created while the listing runs counts as modified after + // the sweep began and is kept + let now = DateTimeOffset.UtcNow + + try + use iterator = client.GetDatabaseQueryIterator() + + while iterator.HasMoreResults do + let! page = iterator.ReadNextAsync cancellationToken + + for database in page do + if database.Id.StartsWith (DatabaseIdentifier.Prefix, StringComparison.Ordinal) then + match lastModifiedOf database with + | ValueSome lastModified when isLeftover minimumAge now lastModified -> leftovers.Add database.Id + // Too young or of unknown age: possibly the live database of another test process + | _ -> keptCount <- keptCount + 1 + with ex -> + testContext.WriteLine $"Could not list the databases to sweep leftover test databases: {ex.Message}" + + if keptCount > 0 then + testContext.WriteLine + $"Kept {keptCount} test database(s) younger than {minimumAge.TotalMinutes} minute(s) or of unknown age: they may belong to a test process that is still running." + + for databaseId in leftovers do + try + let! _ = client.GetDatabase(databaseId).DeleteAsync(cancellationToken = cancellationToken) + testContext.WriteLine $"Deleted the leftover test database '{databaseId}'." + with ex -> + testContext.WriteLine $"Could not delete the leftover test database '{databaseId}': {ex.Message}" +} diff --git a/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj b/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj index 662708f..ee3a1b4 100644 --- a/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj +++ b/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj @@ -19,6 +19,8 @@ + + diff --git a/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs b/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs index 0387b0a..a6cb01d 100644 --- a/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs +++ b/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs @@ -2,8 +2,6 @@ namespace FSharp.Azure.Cosmos.Tests.Integration open System open System.Net -open System.Net.Http -open System.Net.Security open System.Threading open System.Threading.Tasks @@ -12,36 +10,6 @@ open Microsoft.VisualStudio.TestTools.UnitTesting open FSharp.Azure.Cosmos.Tests -/// Extensions of the MSTest test context used by the integration test fixtures. -[] -module TestContextExtensions = - - type TestContext with - - /// - /// Builds the identifier of the database a test creates from the test name and its data row. - /// - member ctx.GetTestDatabaseIdentifier () = - match ctx.TestData with - | null -> ctx.TestName - | testData -> - let dataHash = - testData - |> Array.fold - (fun acc item -> - let itemHash = - match item with - | null -> 0 - | item -> item.GetHashCode () - - HashCode.Combine (acc, itemHash) - ) - 0 - |> int64 - |> abs - - $"{ctx.TestName}_{dataHash}" - /// /// The base class of every test class: holds the MSTest injects. /// @@ -63,41 +31,8 @@ type TestBase () = /// test and deleted after it. Scenarios derive from it and override . /// type DatabaseTestApplicationFactory (testContext : TestContext) = - [] - let endpoint = "https://127.0.0.1:8081" - - [] - let primaryKey = - "C2y6yDjf5/R+ob0N8A7Cgv30VRDJIWEHLM+4QDU5DE2nQ9nDuVTqobD4b8mGGyPMbIZnqyMsEcaGQy67XIw/Jw==" - - let buildDatabaseId () = testContext.GetTestDatabaseIdentifier () - - let databaseId = buildDatabaseId () - - let isLocalEmulatorHost (uri : Uri) = - uri.Host.Equals ("localhost", StringComparison.OrdinalIgnoreCase) - || uri.Host.Equals ("127.0.0.1", StringComparison.OrdinalIgnoreCase) - - let createHttpClient () = - let handler = - new HttpClientHandler ( - ServerCertificateCustomValidationCallback = - (fun request _ _ errors -> - match request.RequestUri with - | null -> errors = SslPolicyErrors.None - | requestUri when errors = SslPolicyErrors.None -> true - | requestUri -> isLocalEmulatorHost requestUri - ) - ) - - new HttpClient (handler, true) - - let client = - new CosmosClient ( - endpoint, - primaryKey, - CosmosClientOptions (ConnectionMode = ConnectionMode.Gateway, HttpClientFactory = Func createHttpClient) - ) + let databaseId = DatabaseIdentifier.ofTestContext testContext + let client = Emulator.createClient () let mutable database = ValueNone /// @@ -117,12 +52,25 @@ type DatabaseTestApplicationFactory (testContext : TestContext) = member _.Database = database /// - /// Creates the database of this fixture. + /// Creates the database of this fixture, empty: a database of the same identifier that an earlier run left behind + /// is deleted and created anew. /// member _.InitializeAsync (cancellationToken : CancellationToken) : Task = task { - let! createdDatabase = - client.CreateDatabaseIfNotExistsAsync (databaseId, cancellationToken = cancellationToken) - database <- ValueSome createdDatabase.Database + let! response = client.CreateDatabaseIfNotExistsAsync (databaseId, cancellationToken = cancellationToken) + + if response.StatusCode = HttpStatusCode.Created then + database <- ValueSome response.Database + else + // The identifier is stable, so this is the database of this very test from an earlier run that + // was aborted, or whose cleanup failed, too recently for the leftover sweep to delete it. Its + // containers and items would make the test fail, such as a seed that conflicts with an item + // the earlier run created, so the test starts over with an empty database. + testContext.WriteLine + $"Recreating the test database '{databaseId}' that an earlier run of this test left behind." + + let! _ = response.Database.DeleteAsync (cancellationToken = cancellationToken) + let! recreated = client.CreateDatabaseAsync (databaseId, cancellationToken = cancellationToken) + database <- ValueSome recreated.Database } /// diff --git a/tests/Cosmos.Tests/DatabaseIdentifierTests.fs b/tests/Cosmos.Tests/DatabaseIdentifierTests.fs new file mode 100644 index 0000000..61719df --- /dev/null +++ b/tests/Cosmos.Tests/DatabaseIdentifierTests.fs @@ -0,0 +1,195 @@ +namespace FSharp.Azure.Cosmos.Tests + +open System +open Microsoft.VisualStudio.TestTools.UnitTesting + +open FSharp.Azure.Cosmos.Tests.Integration + +/// +/// Emulator-free coverage of : the identifiers under which every +/// creates its database. +/// +[] +type DatabaseIdentifierTests () = + inherit TestBase () + + static let methodIdentifier (className : string) (testName : string) = + DatabaseIdentifier.create { + ClassName = className + TestName = ValueSome testName + TestData = null + DisplayName = null + } + + static let rowIdentifier (testData : objnull array) = + DatabaseIdentifier.create { + ClassName = "Tests.Class" + TestName = ValueSome "Data-driven test" + TestData = testData + DisplayName = null + } + + [] + member _.``create returns the same identifier in every process`` () = + // Expected values computed independently in PowerShell, which sanitises, cuts and encodes on its own and hashes + // with SHA-256 over the UTF-16LE text. A per-process hash such as String.GetHashCode would fail here on the next + // run, and leftovers could then never be reused or swept. + Assert.AreEqual ( + "fsac-test-669e7a45_Create_execute_persists_item", + methodIdentifier + "FSharp.Azure.Cosmos.Tests.Integration.CreateOperationIntegrationTests" + "Create execute persists item", + "The identifier should be the prefix, the hash of the class and test names and the sanitised test name." + ) + + // The row hash covers 15:System.Object[]27:13:System.String9:deletedAt13:System.String12:letters only + Assert.AreEqual ( + "fsac-test-764f2105_IsNotDeletedAsync_evaluates_valid_deleted_field_name_a26a2c80", + DatabaseIdentifier.create { + ClassName = "FSharp.Azure.Cosmos.Tests.Integration.ReadExtensionsIntegrationTests" + TestName = ValueSome "IsNotDeletedAsync evaluates valid deleted field name shapes in the query" + TestData = [| "deletedAt" |] + DisplayName = "letters only" + }, + "The identifier of a data row should end with the cut test name and the stable hash of the row." + ) + + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [", DisplayName = "greater-than sign")>] + [] + [] + [] + member _.``create replaces an invalid character of the test name by an underscore`` (character : string) = + let identifier = methodIdentifier "Tests.Class" $"before{character}after" + + Assert.EndsWith ( + "_before_after", + identifier, + StringComparison.Ordinal, + "The invalid character should be replaced by an underscore." + ) + + [] + member _.``create keeps equally named methods of two classes apart`` () = + Assert.AreNotEqual ( + methodIdentifier "Tests.FirstClass" "Same test name", + methodIdentifier "Tests.SecondClass" "Same test name", + "Equally named methods of two classes should get different identifiers." + ) + + [] + member _.``create keeps apart test names of one class that differ only in replaced characters`` () = + // All three read a_b once sanitised; parallel tests sharing a database would delete it under each other + let identifiers = [| + methodIdentifier "Tests.Class" "a/b" + methodIdentifier "Tests.Class" "a b" + methodIdentifier "Tests.Class" "a_b" + |] + + Assert.HasCount ( + identifiers.Length, + Array.distinct identifiers, + "Test names that read alike once sanitised should get different identifiers." + ) + + [] + member _.``create gives every data row of a method its own identifier`` () = + // Without display names, so that the row values alone tell the rows apart + let identifiers = [| + rowIdentifier [| "" |] + rowIdentifier [| " " |] + rowIdentifier [| null |] + rowIdentifier [| "null" |] + rowIdentifier [| "a,b" |] + rowIdentifier [| "a"; "b" |] + rowIdentifier [| 1 |] + rowIdentifier [| 1L |] + rowIdentifier [| 1.0 |] + rowIdentifier [| '1' |] + rowIdentifier [| "1" |] + rowIdentifier [| "1:1" |] + rowIdentifier [| [| 1; 2 |] |] + rowIdentifier [| [| 1 |]; [| 2 |] |] + rowIdentifier [| [| box 1; box 2 |] |] + // Lone surrogates, which UTF-8 would replace by one and the same U+FFFD. Built at run time, because the + // compiler already replaces a lone surrogate in a string literal by U+FFFD. + rowIdentifier [| String (char 0xD800, 1) |] + rowIdentifier [| String (char 0xDC00, 1) |] + |] + + Assert.HasCount (identifiers.Length, Array.distinct identifiers, "Every data row should get its own identifier.") + + [] + member _.``create keeps apart data rows whose values read alike but differ in type`` () = + // Both read 1; one database for both rows would let them recreate or delete it under each other in parallel + Assert.AreNotEqual ( + rowIdentifier [| 1 |], + rowIdentifier [| 1L |], + "Data rows of 1 as int and of 1 as int64 should get different identifiers." + ) + + [] + member _.``create cuts a long name to the maximum length and keeps apart names that differ only beyond the cut`` () = + let commonStart = String.replicate 100 "a" + let first = methodIdentifier "Tests.Class" $"{commonStart} first" + let second = methodIdentifier "Tests.Class" $"{commonStart} second" + + Assert.HasCount (DatabaseIdentifier.MaxLength, first, "A long name should be cut to the maximum length.") + Assert.HasCount (DatabaseIdentifier.MaxLength, second, "A long name should be cut to the maximum length.") + Assert.AreNotEqual (first, second, "Names that differ only beyond the cut should get different identifiers.") + + [] + member _.``create names a class-level database after the class and apart from a method named like the class`` () = + let classIdentifier = + DatabaseIdentifier.create { + ClassName = "Tests.Integration.Scenario" + TestName = ValueNone + TestData = null + DisplayName = null + } + + Assert.StartsWith ( + DatabaseIdentifier.Prefix, + classIdentifier, + StringComparison.Ordinal, + "A class-level identifier should start with the common prefix." + ) + + Assert.EndsWith ( + "-Scenario", + classIdentifier, + StringComparison.Ordinal, + "A class-level identifier should end with the class name." + ) + + Assert.AreNotEqual ( + methodIdentifier "Tests.Integration.Scenario" "Scenario", + classIdentifier, + "A class-level identifier should differ from the one of a method named like the class." + ) + + [] + [] + member this.``ofTestContext reads the class, the test name and the data row of the running test`` (_ : string) = + let expected = + DatabaseIdentifier.create { + ClassName = "FSharp.Azure.Cosmos.Tests.DatabaseIdentifierTests" + TestName = ValueSome "ofTestContext reads the class, the test name and the data row of the running test" + TestData = [| "row value" |] + DisplayName = "row display name" + } + + Assert.AreEqual ( + expected, + DatabaseIdentifier.ofTestContext this.TestContext, + "The identifier should be built from the class, the test name, the data row and its display name." + ) diff --git a/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj b/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj index fc2e29c..e04bfda 100644 --- a/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj +++ b/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj @@ -18,9 +18,12 @@ + + + diff --git a/tests/Cosmos.Tests/LeftoverSweepTests.fs b/tests/Cosmos.Tests/LeftoverSweepTests.fs new file mode 100644 index 0000000..3edb7b9 --- /dev/null +++ b/tests/Cosmos.Tests/LeftoverSweepTests.fs @@ -0,0 +1,80 @@ +namespace FSharp.Azure.Cosmos.Tests + +open System +open Microsoft.Azure.Cosmos +open Microsoft.VisualStudio.TestTools.UnitTesting +open Newtonsoft.Json + +open FSharp.Azure.Cosmos.Tests.Integration + +/// +/// Emulator-free coverage of how tells a leftover test database +/// from the live database of another test process: decides by the time that passed +/// since the database was modified last, which reads. +/// +[] +type LeftoverSweepTests () = + + static let now = DateTimeOffset (2026, 10, 3, 12, 0, 0, TimeSpan.Zero) + static let oneHour = TimeSpan.FromHours 1.0 + + // Through the SDK's own Newtonsoft.Json converter for _ts, so that the kind of the DateTime it produces is covered too + static let deserializeDatabase (json : string) = + JsonConvert.DeserializeObject json + |> nonNull + + [] + [] + [] + [] + member _.``isLeftover keeps a database modified more recently than the minimum age`` (secondsBefore : int) = + Assert.IsFalse ( + Emulator.isLeftover oneHour now (now.AddSeconds (float -secondsBefore)), + "A database younger than the minimum age may belong to a test process that is still running and must be kept." + ) + + [] + [] + [] + [] + member _.``isLeftover sweeps a database modified the minimum age before or earlier`` (secondsBefore : int) = + Assert.IsTrue ( + Emulator.isLeftover oneHour now (now.AddSeconds (float -secondsBefore)), + "A database that stayed unmodified for the minimum age should be swept as a leftover." + ) + + [] + member _.``isLeftover with a zero minimum age sweeps a database modified at the moment of the sweep`` () = + Assert.IsTrue ( + Emulator.isLeftover TimeSpan.Zero now now, + "A zero minimum age should sweep every test database that exists when the sweep begins." + ) + + [] + member _.``isLeftover keeps a database modified after the moment of the sweep even with a zero minimum age`` () = + // A database created while the sweep lists the databases, or stamped by an emulator clock that runs ahead + Assert.IsFalse ( + Emulator.isLeftover TimeSpan.Zero now (now.AddSeconds 1.0), + "A database modified after the sweep began should never be swept." + ) + + [] + member _.``lastModifiedOf reads the _ts system property as UTC seconds since the Unix epoch`` () = + // Reading the SDK's DateTime as local time would shift the instant by this machine's offset + let database = deserializeDatabase """{ "id": "fsac-test-database", "_ts": 1790000000 }""" + + Assert.AreEqual ( + ValueSome (DateTimeOffset.FromUnixTimeSeconds 1790000000L), + Emulator.lastModifiedOf database, + "The last modification should be the instant the _ts seconds denote." + ) + + [] + member _.``lastModifiedOf returns ValueNone when the database reports no _ts`` () = + let database = deserializeDatabase """{ "id": "fsac-test-database" }""" + + Assert.AreEqual ( + ValueNone, + Emulator.lastModifiedOf database, + "A database without _ts should have no last modification, so that the sweep keeps it." + ) diff --git a/tests/Cosmos.Tests/TestAssembly.fs b/tests/Cosmos.Tests/TestAssembly.fs new file mode 100644 index 0000000..b53f736 --- /dev/null +++ b/tests/Cosmos.Tests/TestAssembly.fs @@ -0,0 +1,42 @@ +namespace FSharp.Azure.Cosmos.Tests + +open System.Threading.Tasks +open Microsoft.VisualStudio.TestTools.UnitTesting + +open FSharp.Azure.Cosmos.Tests.Integration + +/// +/// The assembly-level hooks of this test project. MSTest allows one method +/// per assembly, so everything that has to run once before the first test belongs to . +/// +/// and both run , +/// which deletes only the test databases that stayed unmodified for longer than the leftover age +/// (), an hour unless the environment variable +/// COSMOS_TEST_LEFTOVER_AGE_MINUTES, , says otherwise, so that another +/// test process that uses the same emulator at the same time keeps its live databases. Every test deletes its own +/// database in , whatever its age. +/// +/// +/// The age does not keep apart two test processes that run the same test at the same time: the identifier of a test's +/// database is stable, so both use one database and either may delete it under the other. +/// +/// +[] +type TestAssembly () = + + /// + /// Deletes the test databases older than the leftover age that earlier runs left behind, aborted ones or ones whose + /// cleanup failed, whose containers would otherwise keep occupying emulator partitions while this run creates its + /// own. A younger one is kept, because it may belong to a test process that is still running; a test of this run + /// whose database is among them recreates it empty. + /// + [] + static member Initialize (testContext : TestContext) : Task = Emulator.deleteLeftoverDatabasesAsync testContext + + /// + /// Deletes the test databases older than the leftover age that are left once every test has run. This run's own + /// databases are younger: each test has deleted its database in its cleanup already, and one whose best-effort + /// cleanup failed is left to a later sweep once it is old enough. + /// + [] + static member Cleanup (testContext : TestContext) : Task = Emulator.deleteLeftoverDatabasesAsync testContext diff --git a/tests/Cosmos.Tests/TestCategories.fs b/tests/Cosmos.Tests/TestCategories.fs index 53bc6bd..440cee9 100644 --- a/tests/Cosmos.Tests/TestCategories.fs +++ b/tests/Cosmos.Tests/TestCategories.fs @@ -72,3 +72,11 @@ type IterationExtensionsUnitTestCategoryAttribute () = type ResponseMessageUnitTestCategoryAttribute () = inherit TestCategoryBaseAttribute () override _.TestCategories = [| "Unit"; "ResponseMessage" |] :> IList + +/// +/// Categorizes the tests of the shared test infrastructure as fast, emulator-free unit tests: +/// and . +/// +type TestInfrastructureUnitTestCategoryAttribute () = + inherit TestCategoryBaseAttribute () + override _.TestCategories = [| "Unit"; "TestInfrastructure" |] :> IList From 27763cea6bbba8414a1dad5b92b5f065c9729aac Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Fri, 2 Oct 2026 23:42:51 +0200 Subject: [PATCH 3/4] test: guard the emulator partition budget Keep the integration fixtures within the limits of the local emulator, which answers HTTP 500 and 503 on container creation at the default parallelism (ADR 0001 section 22.4). A process-wide PartitionBudget, sized by COSMOS_EMULATOR_PARTITION_COUNT (default 25, the Windows emulator's default), hands out one permit per container. A fixture declares how many containers it creates (ContainerCount, default 1) and takes all their permits at once before it creates its database: only one caller at a time is between its first and its last permit, so fixtures can no longer each hold part of what they need and wait for each other. A cancelled acquisition gives back what it took, and the fixture releases exactly the number it acquired, in a finally block. Creating a container beyond ContainerCount fails, and the hierarchical container of the read extension tests is now created through the fixture. The partition count is read by a function rather than a value, so a malformed variable fails only the fixtures that need the budget. A second semaphore serialises database and container creation, the recreation of a database an earlier run left behind included, with the wait placed before the try. Cleanup is best-effort: a failed deletion is written to the TestContext and left to the next run of the same test, which recreates the database, or to the leftover sweep once it is old enough, instead of failing the test, and a fixture whose initialization failed half-way is cleaned up by [], which MSTest also runs after a failed []. Setup, seeding and cleanup pass the TestContext cancellation token; cleanup reads it at cleanup time, when MSTest has replaced the token source of a timed-out test. The documentation names PartitionBudget, the fixture and the sweep through , and that of the hierarchical container names PartitionKeyBuilder.AddNoneType for the level its items lack. Emulator-free unit tests cover the budget, including a scenario in which taking the permits one at a time deadlocks. Co-Authored-By: Claude Opus 5.5 --- tests/Cosmos.Tests.Infrastructure/Emulator.fs | 34 ++++ ...p.Azure.Cosmos.Tests.Infrastructure.fsproj | 1 + .../IntegrationInfrastructure.fs | 161 ++++++++++++++---- .../PartitionBudget.fs | 90 ++++++++++ .../FSharp.Azure.Cosmos.Tests.fsproj | 1 + tests/Cosmos.Tests/PartitionBudgetTests.fs | 115 +++++++++++++ tests/Cosmos.Tests/ReadExtensionsTests.fs | 20 +-- tests/Cosmos.Tests/TestCategories.fs | 2 +- 8 files changed, 377 insertions(+), 47 deletions(-) create mode 100644 tests/Cosmos.Tests.Infrastructure/PartitionBudget.fs create mode 100644 tests/Cosmos.Tests/PartitionBudgetTests.fs diff --git a/tests/Cosmos.Tests.Infrastructure/Emulator.fs b/tests/Cosmos.Tests.Infrastructure/Emulator.fs index 6909e2e..b73d667 100644 --- a/tests/Cosmos.Tests.Infrastructure/Emulator.fs +++ b/tests/Cosmos.Tests.Infrastructure/Emulator.fs @@ -63,6 +63,40 @@ let key = readVariable KeyVariable |> ValueOption.defaultValue DefaultKey +/// +/// The environment variable that overrides . +/// +[] +let PartitionCountVariable = "COSMOS_EMULATOR_PARTITION_COUNT" + +/// +/// The default /PartitionCount of the Windows emulator. How many partitions one container costs on each +/// emulator is not settled yet: every counts one per container. +/// +[] +let DefaultPartitionCount = 25 + +/// +/// Reads the number of partitions the emulator offers, which bounds how many test containers exist at the same +/// time: the value of when it is set, otherwise +/// . +/// +/// +/// A function rather than a value, so that a malformed variable fails the fixtures that need the +/// and not everything else that touches this module, such as the emulator-free tests +/// through . +/// +/// +/// is set to something other than a positive integer. +/// +let readPartitionCount () : int = + match readVariable PartitionCountVariable with + | ValueNone -> DefaultPartitionCount + | ValueSome text -> + match Int32.TryParse (text, NumberStyles.None, CultureInfo.InvariantCulture) with + | true, count when count > 0 -> count + | _ -> invalidOp $"{PartitionCountVariable} must be a positive integer, but it is '{text}'." + /// /// The environment variable that overrides . /// diff --git a/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj b/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj index ee3a1b4..d5416dd 100644 --- a/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj +++ b/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj @@ -19,6 +19,7 @@ + diff --git a/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs b/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs index a6cb01d..e187289 100644 --- a/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs +++ b/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs @@ -1,6 +1,7 @@ namespace FSharp.Azure.Cosmos.Tests.Integration open System +open System.Collections.Generic open System.Net open System.Threading open System.Threading.Tasks @@ -30,10 +31,43 @@ type TestBase () = /// The fixture of one emulator-backed test: a and a database of its own, created before the /// test and deleted after it. Scenarios derive from it and override . /// +/// +/// +/// Before it creates its database in , the fixture takes one permit of the emulator's +/// for each container it may create (), all at once, and +/// gives back exactly the permits it took. Database and container creation is serialised +/// across parallel tests. Both keep the emulator within the limits it answers with HTTP 500 and 503 beyond. +/// +/// +/// Cleanup is best-effort: a database that cannot be deleted is written to the and left to +/// the next run of the same test, which recreates it, or to once +/// it is old enough, so cleanup never fails a test, and it tolerates a fixture whose initialization failed half-way. +/// +/// type DatabaseTestApplicationFactory (testContext : TestContext) = + + // Process-wide: every fixture of the test run shares the one emulator + static let partitionBudget = PartitionBudget (Emulator.readPartitionCount ()) + + // Serialises database and container creation across parallel tests: the emulator answers HTTP 500 and 503 when + // many creations arrive at once + static let creation = new SemaphoreSlim (1, 1) + let databaseId = DatabaseIdentifier.ofTestContext testContext let client = Emulator.createClient () + let createdContainerIds = HashSet(StringComparer.Ordinal) let mutable database = ValueNone + let mutable acquiredPartitions = 0 + + let createSerializedAsync (cancellationToken : CancellationToken) (create : unit -> Task<'Result>) : Task<'Result> = task { + // Outside the try: a cancelled wait must not release a turn it never got + do! creation.WaitAsync cancellationToken + + try + return! create () + finally + creation.Release () |> ignore + } /// /// The client connected to the emulator. @@ -47,48 +81,82 @@ type DatabaseTestApplicationFactory (testContext : TestContext) = /// /// The database this fixture created; before - /// and after . + /// and after . Create containers through + /// , which counts them against the . /// member _.Database = database /// - /// Creates the database of this fixture, empty: a database of the same identifier that an earlier run left behind - /// is deleted and created anew. + /// The number of containers this fixture creates at most, each of which costs one partition of the emulator. + /// Override it in a scenario that creates more than one container. /// - member _.InitializeAsync (cancellationToken : CancellationToken) : Task = task { - let! response = client.CreateDatabaseIfNotExistsAsync (databaseId, cancellationToken = cancellationToken) - - if response.StatusCode = HttpStatusCode.Created then - database <- ValueSome response.Database - else - // The identifier is stable, so this is the database of this very test from an earlier run that - // was aborted, or whose cleanup failed, too recently for the leftover sweep to delete it. Its - // containers and items would make the test fail, such as a seed that conflicts with an item - // the earlier run created, so the test starts over with an empty database. - testContext.WriteLine - $"Recreating the test database '{databaseId}' that an earlier run of this test left behind." - - let! _ = response.Database.DeleteAsync (cancellationToken = cancellationToken) - let! recreated = client.CreateDatabaseAsync (databaseId, cancellationToken = cancellationToken) - database <- ValueSome recreated.Database + abstract ContainerCount : int + default _.ContainerCount = 1 + + /// + /// Takes the permits of containers and creates the + /// database of this fixture, empty: a database of the same identifier that an earlier run left behind is deleted + /// and created anew. + /// + member this.InitializeAsync (cancellationToken : CancellationToken) : Task = task { + let! acquired = partitionBudget.AcquireAsync (this.ContainerCount, cancellationToken) + acquiredPartitions <- acquired + + let! createdDatabase = + createSerializedAsync + cancellationToken + (fun () -> task { + let! response = client.CreateDatabaseIfNotExistsAsync (databaseId, cancellationToken = cancellationToken) + + if response.StatusCode = HttpStatusCode.Created then + return response.Database + else + // The identifier is stable, so this is the database of this very test from an earlier run that + // was aborted, or whose cleanup failed, too recently for the leftover sweep to delete it. Its + // containers and items would make the test fail, such as a seed that conflicts with an item + // the earlier run created, so the test starts over with an empty database. + testContext.WriteLine + $"Recreating the test database '{databaseId}' that an earlier run of this test left behind." + + let! _ = response.Database.DeleteAsync (cancellationToken = cancellationToken) + let! recreated = client.CreateDatabaseAsync (databaseId, cancellationToken = cancellationToken) + return recreated.Database + }) + + database <- ValueSome createdDatabase } /// - /// Deletes the database of this fixture. + /// Deletes the database of this fixture and gives its permits back to the . + /// Best-effort: a failed deletion is written to the instead of failing the test. /// member _.CleanupAsync (cancellationToken : CancellationToken) : Task = task { - match database with - | ValueNone -> () - | ValueSome existingDatabase -> - let! _ = existingDatabase.DeleteAsync (cancellationToken = cancellationToken) - database <- ValueNone + try + match database with + | ValueNone -> () + | ValueSome existingDatabase -> + database <- ValueNone + + try + let! _ = existingDatabase.DeleteAsync (cancellationToken = cancellationToken) + () + with ex -> + testContext.WriteLine + $"Best-effort cleanup could not delete the test database '{databaseId}', so the next run of this test recreates it or the sweep of leftover databases deletes it once it is old enough. {ex.GetType().Name}: {ex.Message}" + finally + partitionBudget.Release acquiredPartitions + acquiredPartitions <- 0 } /// /// Creates a container in the database of this fixture unless it exists, and returns it. /// + /// + /// The database is not initialized, or the container would exceed the this fixture + /// took partition permits for. + /// member _.GetOrCreateContainerAsync - (containerId : string, partitionKeyPath : string, cancellationToken : CancellationToken) + (containerProperties : ContainerProperties, cancellationToken : CancellationToken) : Task = task { let database = @@ -96,15 +164,36 @@ type DatabaseTestApplicationFactory (testContext : TestContext) = | ValueSome existingDatabase -> existingDatabase | ValueNone -> invalidOp "Database is not initialized." - let! containerResponse = - database.CreateContainerIfNotExistsAsync ( - ContainerProperties (containerId, partitionKeyPath), - cancellationToken = cancellationToken - ) + return! + createSerializedAsync + cancellationToken + (fun () -> task { + // Checked under the creation lock, which also guards createdContainerIds + if + not (createdContainerIds.Contains containerProperties.Id) + && createdContainerIds.Count >= acquiredPartitions + then + invalidOp + $"The fixture of '{databaseId}' took partition permits for {acquiredPartitions} container(s) and cannot create '{containerProperties.Id}' as well; override ContainerCount in its scenario." + + let! containerResponse = + database.CreateContainerIfNotExistsAsync (containerProperties, cancellationToken = cancellationToken) - return containerResponse.Container + createdContainerIds.Add containerProperties.Id |> ignore + return containerResponse.Container + }) } + /// + /// Creates a container with a single partition key path in the database of this fixture unless it exists, and + /// returns it. + /// + member this.GetOrCreateContainerAsync + (containerId : string, partitionKeyPath : string, cancellationToken : CancellationToken) + : Task + = + this.GetOrCreateContainerAsync (ContainerProperties (containerId, partitionKeyPath), cancellationToken) + /// /// Seeds the data of a scenario after the database is created; does nothing unless overridden. /// @@ -116,7 +205,9 @@ type DatabaseTestApplicationFactory (testContext : TestContext) = member this.DisposeAsync () = task { try - do! this.CleanupAsync (CancellationToken.None) + // Read at cleanup time: MSTest gives [] a fresh token source, so a test that timed out + // still deletes its database + do! this.CleanupAsync testContext.CancellationToken finally client.Dispose () } @@ -156,6 +247,8 @@ type IntegrationTestBase<'DatabaseTestApplicationFactory when 'DatabaseTestAppli [] member this.Initialize () : Task = task { let application = this.CreateApplication (this.TestContext) + // Stored before initialization: MSTest runs [] after a failed [] as well, and + // the cleanup gives back whatever a half-initialized fixture already holds this.application <- ValueSome application do! application.InitializeAsync (this.CancellationToken) do! application.SeedDataAsync (this.CancellationToken) @@ -169,8 +262,8 @@ type IntegrationTestBase<'DatabaseTestApplicationFactory when 'DatabaseTestAppli match this.application with | ValueNone -> () | ValueSome application -> - do! (application :> IAsyncDisposable).DisposeAsync() this.application <- ValueNone + do! (application :> IAsyncDisposable).DisposeAsync() } /// diff --git a/tests/Cosmos.Tests.Infrastructure/PartitionBudget.fs b/tests/Cosmos.Tests.Infrastructure/PartitionBudget.fs new file mode 100644 index 0000000..b1e903a --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/PartitionBudget.fs @@ -0,0 +1,90 @@ +namespace FSharp.Azure.Cosmos.Tests.Integration + +open System +open System.Threading +open System.Threading.Tasks + +/// +/// A counting semaphore over the partitions of the Cosmos DB Emulator, from which every +/// takes one permit per container it creates. +/// +/// +/// +/// The permits of one fixture are acquired atomically: taking them one at a time while other fixtures do the same can +/// deadlock once every fixture holds part of what it needs and waits for the rest. Here only one caller at a time is +/// between its first and its last permit; a caller that holds permits never waits for more, so the one that is +/// acquiring always gets the permits it waits for as soon as other fixtures release theirs. +/// +/// +/// A cancelled acquisition gives back the permits it already took, so a caller holds either all the permits it asked +/// for or none, and must release exactly the number returned. +/// +/// +[] +type PartitionBudget (limit : int) = + + do + if limit < 1 then + raise (ArgumentOutOfRangeException (nameof limit, limit, "The partition budget needs at least one partition.")) + + let permits = new SemaphoreSlim (limit, limit) + let acquisition = new SemaphoreSlim (1, 1) + + let validateCount (count : int) = + if count < 0 || count > limit then + raise ( + ArgumentOutOfRangeException ( + nameof count, + count, + $"A fixture can take between 0 and {limit} partitions of this budget; " + + "raise COSMOS_EMULATOR_PARTITION_COUNT together with the emulator's partition count to create more containers." + ) + ) + + /// + /// The number of permits nobody holds at the moment. + /// + member _.Available = permits.CurrentCount + + /// + /// Waits until permits are free and takes all of them at once. + /// + /// The number of permits taken, which the caller passes to . + /// + /// is negative or larger than the budget, so the wait would never end. + /// + /// + /// was cancelled; no permits are held then. + /// + member _.AcquireAsync (count : int, cancellationToken : CancellationToken) : Task = task { + validateCount count + + if count = 0 then + return 0 + else + // Outside the try: a cancelled wait for the turn must not release a turn it never got + do! acquisition.WaitAsync cancellationToken + let mutable acquired = 0 + + try + while acquired < count do + do! permits.WaitAsync cancellationToken + acquired <- acquired + 1 + finally + // Only a cancelled wait leaves the loop early: give back what was taken, the caller gets nothing + if acquired < count && acquired > 0 then + permits.Release acquired |> ignore + + acquisition.Release () |> ignore + + return count + } + + /// + /// Gives back permits that returned. + /// + member _.Release (count : int) : unit = + validateCount count + + if count > 0 then + permits.Release count |> ignore diff --git a/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj b/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj index e04bfda..06996ea 100644 --- a/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj +++ b/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj @@ -23,6 +23,7 @@ + diff --git a/tests/Cosmos.Tests/PartitionBudgetTests.fs b/tests/Cosmos.Tests/PartitionBudgetTests.fs new file mode 100644 index 0000000..b14cf92 --- /dev/null +++ b/tests/Cosmos.Tests/PartitionBudgetTests.fs @@ -0,0 +1,115 @@ +namespace FSharp.Azure.Cosmos.Tests + +open System +open System.Threading +open System.Threading.Tasks +open Microsoft.VisualStudio.TestTools.UnitTesting + +open FSharp.Azure.Cosmos.Tests.Integration + +/// +/// Emulator-free coverage of , which keeps the fixtures of the integration tests, +/// instances, within the emulator's partition count. +/// +[] +type PartitionBudgetTests () = + + // Long enough never to fire on a healthy machine; it only turns a deadlock into a failure instead of a hang + static let deadlockTimeout = TimeSpan.FromSeconds 30.0 + + [] + member _.``AcquireAsync takes the requested permits and Release gives them back`` () : Task = task { + let budget = PartitionBudget 3 + + let! acquired = budget.AcquireAsync (2, CancellationToken.None) + + Assert.AreEqual (2, acquired, "AcquireAsync should report the number of permits it took.") + Assert.AreEqual (1, budget.Available, "Two of three permits should be held.") + + budget.Release acquired + + Assert.AreEqual (3, budget.Available, "Release should give every permit back.") + } + + [] + member _.``AcquireAsync waits until enough permits are released`` () : Task = task { + let budget = PartitionBudget 2 + let! held = budget.AcquireAsync (2, CancellationToken.None) + + let waiting = budget.AcquireAsync (1, CancellationToken.None) + + Assert.IsFalse (waiting.IsCompleted, "AcquireAsync should wait while no permit is free.") + + budget.Release held + let! acquired = waiting.WaitAsync deadlockTimeout + + Assert.AreEqual (1, acquired, "AcquireAsync should take its permit once one is released.") + } + + [] + member _.``AcquireAsync gives back the permits it took when it is cancelled`` () : Task = task { + let budget = PartitionBudget 2 + let! held = budget.AcquireAsync (1, CancellationToken.None) + use cancellation = new CancellationTokenSource () + + // Takes the one free permit, then waits for the second + let waiting = budget.AcquireAsync (2, cancellation.Token) + cancellation.Cancel () + + let! _ = + Assert.ThrowsAsync( + Func(fun () -> waiting :> Task), + "A cancelled AcquireAsync should throw OperationCanceledException." + ) + + Assert.AreEqual (1, budget.Available, "A cancelled AcquireAsync should give back the permit it already took.") + + budget.Release held + let! acquired = (budget.AcquireAsync (2, CancellationToken.None)).WaitAsync deadlockTimeout + + Assert.AreEqual (2, acquired, "Every permit should be available again after the cancelled acquisition.") + } + + [] + member _.``AcquireAsync rejects a count larger than the budget`` () : Task = task { + let budget = PartitionBudget 2 + + let! _ = + Assert.ThrowsExactlyAsync( + Func(fun () -> budget.AcquireAsync (3, CancellationToken.None) :> Task), + "AcquireAsync should reject a count it could never satisfy instead of waiting forever." + ) + + () + } + + [] + member _.``AcquireAsync never deadlocks or exceeds the budget when fixtures need several permits each`` () : Task = task { + // Three permits and fixtures that need two each: taking the permits one at a time would let two fixtures hold + // one each and wait for each other forever + let budget = PartitionBudget 3 + let sync = obj () + let held = ref 0 + let maximumHeld = ref 0 + + let fixture () : Task = task { + let! acquired = budget.AcquireAsync (2, CancellationToken.None) + + lock + sync + (fun () -> + held.Value <- held.Value + acquired + maximumHeld.Value <- max maximumHeld.Value held.Value + ) + + do! Task.Yield () + lock sync (fun () -> held.Value <- held.Value - acquired) + budget.Release acquired + } + + let fixtures = [| for _ in 1..200 -> Task.Run (Func fixture) |] + do! (Task.WhenAll fixtures).WaitAsync deadlockTimeout + + Assert.IsLessThanOrEqualTo (3, maximumHeld.Value, "The fixtures should never hold more permits than the budget has.") + Assert.AreEqual (3, budget.Available, "Every permit should be given back once all fixtures are done.") + } diff --git a/tests/Cosmos.Tests/ReadExtensionsTests.fs b/tests/Cosmos.Tests/ReadExtensionsTests.fs index b574c11..6513dcc 100644 --- a/tests/Cosmos.Tests/ReadExtensionsTests.fs +++ b/tests/Cosmos.Tests/ReadExtensionsTests.fs @@ -95,19 +95,15 @@ type ReadExtensionsIntegrationTests () = /// /// Creates a container with a two-level hierarchical partition key, /partitionKey then /subKey. - /// has no subKey field, so its full key ends with a None level, as in issue #31. + /// has no subKey field, so its full key ends with a level added by + /// , as in issue #31. /// - member private this.GetHierarchicalContainer () : Task = task { - let database = - this.Application.Database - |> ValueOption.defaultWith (fun () -> invalidOp "Database is not initialized.") - let! response = - database.CreateContainerIfNotExistsAsync ( - ContainerProperties ("hierarchical-tests", [| "/partitionKey"; "/subKey" |]), - cancellationToken = this.CancellationToken - ) - return response.Container - } + member private this.GetHierarchicalContainer () : Task = + // Through the fixture, which counts the container against the partition budget and serialises its creation + this.Application.GetOrCreateContainerAsync ( + ContainerProperties ("hierarchical-tests", [| "/partitionKey"; "/subKey" |]), + this.CancellationToken + ) [] member this.``ExistsAsync with a full hierarchical partition key checks the item by point read`` () : Task = task { diff --git a/tests/Cosmos.Tests/TestCategories.fs b/tests/Cosmos.Tests/TestCategories.fs index 440cee9..faf9385 100644 --- a/tests/Cosmos.Tests/TestCategories.fs +++ b/tests/Cosmos.Tests/TestCategories.fs @@ -75,7 +75,7 @@ type ResponseMessageUnitTestCategoryAttribute () = /// /// Categorizes the tests of the shared test infrastructure as fast, emulator-free unit tests: -/// and . +/// , and . /// type TestInfrastructureUnitTestCategoryAttribute () = inherit TestCategoryBaseAttribute () From a7b9109b6d3624c988cd096bb235f927265ebf1a Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 3 Oct 2026 00:51:40 +0200 Subject: [PATCH 4/4] docs: document the test infrastructure project and its environment variables The shared test infrastructure project was missing from the solution tree of the agent instructions, and the environment variables it reads were only discoverable from its source. Agents and contributors running the tests against another emulator, a smaller emulator or next to another test process need to know COSMOS_EMULATOR_ENDPOINT, COSMOS_EMULATOR_KEY, COSMOS_EMULATOR_PARTITION_COUNT with its default of 25 and COSMOS_TEST_LEFTOVER_AGE_MINUTES with its default of 60, and that a new test project gets the infrastructure through tests/Directory.Build.props rather than a ProjectReference of its own. Co-Authored-By: Claude Opus 5.5 --- .github/copilot-instructions.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/copilot-instructions.md b/.github/copilot-instructions.md index 46fd752..6db9d73 100644 --- a/.github/copilot-instructions.md +++ b/.github/copilot-instructions.md @@ -26,6 +26,7 @@ │ ├── TaskSeq.fs – TaskSeq integration │ └── UniqueKey.fs – unique key helpers ├── tests/Cosmos.Tests/ – MSTest integration test project +├── tests/Cosmos.Tests.Infrastructure/ – shared test fixtures, emulator settings and assertion helpers ├── build/ – FAKE build scripts └── docsSrc/ – FSharp.Formatting documentation source ``` @@ -228,6 +229,11 @@ module MyTypeExtensions = * The emulator must be running locally or installed via the `copilot-setup-steps.yml` workflow. * Emulator endpoint: `https://127.0.0.1:8081` * Emulator primary key: `C2y6yDjf5/R+ob0N8A7Cgv30VRDJIWEHLM+4QDU5DE2nQ9nDuVTqobD4b8mGGyPMbIZnqyMsEcaGQy67XIw/Jw==` +* `COSMOS_EMULATOR_ENDPOINT` overrides the emulator endpoint the tests connect to. +* `COSMOS_EMULATOR_KEY` overrides the emulator key the tests authenticate with. +* `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. +* 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. * `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.