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. 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/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..b73d667 --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/Emulator.fs @@ -0,0 +1,275 @@ +/// +/// 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 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 . +/// +[] +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 new file mode 100644 index 0000000..d5416dd --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/FSharp.Azure.Cosmos.Tests.Infrastructure.fsproj @@ -0,0 +1,38 @@ + + + + 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.Infrastructure/IntegrationInfrastructure.fs b/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs new file mode 100644 index 0000000..e187289 --- /dev/null +++ b/tests/Cosmos.Tests.Infrastructure/IntegrationInfrastructure.fs @@ -0,0 +1,276 @@ +namespace FSharp.Azure.Cosmos.Tests.Integration + +open System +open System.Collections.Generic +open System.Net +open System.Threading +open System.Threading.Tasks + +open Microsoft.Azure.Cosmos +open Microsoft.VisualStudio.TestTools.UnitTesting + +open FSharp.Azure.Cosmos.Tests + +/// +/// 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 . +/// +/// +/// +/// 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. + /// + member _.Client = client + + /// + /// The identifier of the database this fixture creates. + /// + member _.DatabaseId = databaseId + + /// + /// The database this fixture created; before + /// and after . Create containers through + /// , which counts them against the . + /// + member _.Database = database + + /// + /// 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. + /// + 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 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 { + 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 + (containerProperties : ContainerProperties, cancellationToken : CancellationToken) + : Task + = task { + let database = + match database with + | ValueSome existingDatabase -> existingDatabase + | ValueNone -> invalidOp "Database is not initialized." + + 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) + + 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. + /// + abstract SeedDataAsync : cancellationToken : CancellationToken -> Task + default _.SeedDataAsync (cancellationToken : CancellationToken) = Task.CompletedTask + + interface IAsyncDisposable with + /// + member this.DisposeAsync () = + task { + try + // 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 () + } + |> 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> + () + = + inherit TestBase () + + 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) + // 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) + } + + /// + /// Disposes , deleting its database. + /// + [] + member this.Cleanup () : Task = task { + match this.application with + | ValueNone -> () + | ValueSome application -> + this.application <- ValueNone + do! (application :> IAsyncDisposable).DisposeAsync() + } + +/// +/// 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/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.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/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 4f42acf..06996ea 100644 --- a/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj +++ b/tests/Cosmos.Tests/FSharp.Azure.Cosmos.Tests.fsproj @@ -18,12 +18,13 @@ + - - - + + + diff --git a/tests/Cosmos.Tests/IntegrationInfrastructure.fs b/tests/Cosmos.Tests/IntegrationInfrastructure.fs deleted file mode 100644 index afe345c..0000000 --- a/tests/Cosmos.Tests/IntegrationInfrastructure.fs +++ /dev/null @@ -1,168 +0,0 @@ -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 - -open Microsoft.Azure.Cosmos -open Microsoft.VisualStudio.TestTools.UnitTesting - -[] -module TestContextExtensions = - - type TestContext with - - 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}" - -[] -type TestBase () = - - member val TestContext = Unchecked.defaultof with get, set - - member this.CancellationToken = this.TestContext.CancellationTokenSource.Token - -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 mutable database = ValueNone - - member _.Client = client - member _.DatabaseId = databaseId - member _.Database = database - - member _.InitializeAsync (cancellationToken : CancellationToken) : Task = task { - let! createdDatabase = - client.CreateDatabaseIfNotExistsAsync (databaseId, cancellationToken = cancellationToken) - database <- ValueSome createdDatabase.Database - } - - member _.CleanupAsync (cancellationToken : CancellationToken) : Task = task { - match database with - | ValueNone -> () - | ValueSome existingDatabase -> - let! _ = existingDatabase.DeleteAsync (cancellationToken = cancellationToken) - database <- ValueNone - } - - member _.GetOrCreateContainerAsync - (containerId : string, partitionKeyPath : string, cancellationToken : CancellationToken) - : Task - = task { - let database = - match database with - | ValueSome existingDatabase -> existingDatabase - | ValueNone -> invalidOp "Database is not initialized." - - let! containerResponse = - database.CreateContainerIfNotExistsAsync ( - ContainerProperties (containerId, partitionKeyPath), - cancellationToken = cancellationToken - ) - - return containerResponse.Container - } - - abstract SeedDataAsync : cancellationToken : CancellationToken -> Task - default _.SeedDataAsync (cancellationToken : CancellationToken) = Task.CompletedTask - - interface IAsyncDisposable with - member this.DisposeAsync () = - task { - try - do! this.CleanupAsync (CancellationToken.None) - finally - client.Dispose () - } - |> ValueTask - -[] -type IntegrationTestBase<'DatabaseTestApplicationFactory when 'DatabaseTestApplicationFactory :> DatabaseTestApplicationFactory> - () - = - inherit TestBase () - - member val private application : 'DatabaseTestApplicationFactory voption = ValueNone with get, set - - member this.Application = - match this.application with - | ValueNone -> invalidOp "Application not initialized. Ensure test runs within TestInitialize/TestCleanup lifecycle." - | ValueSome application -> application - - abstract CreateApplication : TestContext -> 'DatabaseTestApplicationFactory - - [] - member this.Initialize () : Task = task { - let application = this.CreateApplication (this.TestContext) - this.application <- ValueSome application - do! application.InitializeAsync (this.CancellationToken) - do! application.SeedDataAsync (this.CancellationToken) - } - - [] - member this.Cleanup () : Task = task { - match this.application with - | ValueNone -> () - | ValueSome application -> - do! (application :> IAsyncDisposable).DisposeAsync() - this.application <- ValueNone - } - -type IntegrationTestBase () = - inherit IntegrationTestBase () - - override _.CreateApplication context = DatabaseTestApplicationFactory (context) 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/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/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/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 31fbf72..faf9385 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 @@ -76,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 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 + + + + +