Compare commits

...

10 Commits

Author SHA1 Message Date
Patrick Stevens
eeada219f6 Permit async ParallelQueue (#279) 2025-07-29 22:24:58 +01:00
Patrick Stevens
99e0fdff08 Make ParallelQueue surface its errors, correctly flow ExecutionContext (#278) 2025-07-29 22:04:45 +01:00
dependabot[bot]
fda4e7ba60 Bump WoofWare.Myriad.Plugins from 8.0.4 to 8.0.5 (#277)
* Bump WoofWare.Myriad.Plugins from 8.0.4 to 8.0.5

---
updated-dependencies:
- dependency-name: WoofWare.Myriad.Plugins
  dependency-version: 8.0.5
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2025-07-28 20:42:53 +01:00
patrick-conscriptus[bot]
dfdfa84733 Automated commit (#276)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-07-27 00:56:11 +00:00
patrick-conscriptus[bot]
c218110749 Automated commit (#275)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-07-20 00:55:52 +00:00
dependabot[bot]
309968721c Bump ApiSurface from 4.1.21 to 4.1.22 (#274)
* Bump ApiSurface from 4.1.21 to 4.1.22

---
updated-dependencies:
- dependency-name: ApiSurface
  dependency-version: 4.1.22
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2025-07-14 21:03:17 +00:00
patrick-conscriptus[bot]
876ca9e625 Automated commit (#273)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-07-13 00:54:57 +00:00
patrick-conscriptus[bot]
59f9789cdc Automated commit (#271)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-07-06 00:53:02 +00:00
dependabot[bot]
c8c28b9a32 Bump FsUnit to 7.1.1 (#270)
* Bump FsUnit to 7.1.1

---
updated-dependencies:
- dependency-name: FsUnit
  dependency-version: 7.1.1
  dependency-type: direct:production
  update-type: version-update:semver-minor
- dependency-name: FsUnit
  dependency-version: 7.1.1
  dependency-type: direct:production
  update-type: version-update:semver-minor
- dependency-name: FsUnit
  dependency-version: 7.1.1
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2025-06-30 20:56:14 +00:00
patrick-conscriptus[bot]
6d87610017 Automated commit (#269)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-06-29 00:53:55 +00:00
15 changed files with 526 additions and 75 deletions

View File

@@ -3,13 +3,13 @@
"isRoot": true, "isRoot": true,
"tools": { "tools": {
"fantomas": { "fantomas": {
"version": "7.0.2", "version": "7.0.3",
"commands": [ "commands": [
"fantomas" "fantomas"
] ]
}, },
"fsharp-analyzers": { "fsharp-analyzers": {
"version": "0.31.0", "version": "0.32.0",
"commands": [ "commands": [
"fsharp-analyzers" "fsharp-analyzers"
] ]

View File

@@ -27,7 +27,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FsUnit" Version="7.0.1" /> <PackageReference Include="FsUnit" Version="7.1.1" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1"/> <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1"/>
<PackageReference Include="NUnit" Version="4.3.2"/> <PackageReference Include="NUnit" Version="4.3.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.0.0"/> <PackageReference Include="NUnit3TestAdapter" Version="5.0.0"/>

View File

@@ -10,7 +10,7 @@
<WarnOn>FS3388,FS3559</WarnOn> <WarnOn>FS3388,FS3559</WarnOn>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Nerdbank.GitVersioning" Version="3.8.38-alpha" PrivateAssets="all"/> <PackageReference Include="Nerdbank.GitVersioning" Version="3.8.38-alpha" PrivateAssets="all" />
</ItemGroup> </ItemGroup>
<PropertyGroup Condition="'$(GITHUB_ACTION)' != ''"> <PropertyGroup Condition="'$(GITHUB_ACTION)' != ''">
<ContinuousIntegrationBuild>true</ContinuousIntegrationBuild> <ContinuousIntegrationBuild>true</ContinuousIntegrationBuild>

View File

@@ -11,7 +11,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FsUnit" Version="7.0.1" /> <PackageReference Include="FsUnit" Version="7.1.1" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1"/> <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1"/>
<PackageReference Include="NUnit" Version="4.3.2"/> <PackageReference Include="NUnit" Version="4.3.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.0.0"/> <PackageReference Include="NUnit3TestAdapter" Version="5.0.0"/>

View File

@@ -10,20 +10,14 @@ open System.Threading
type internal OutputStreamId = | OutputStreamId of Guid type internal OutputStreamId = | OutputStreamId of Guid
type private ThreadAwareWriter type private ThreadAwareWriter (local : AsyncLocal<OutputStreamId>, underlying : Dictionary<OutputStreamId, TextWriter>)
(
local : AsyncLocal<OutputStreamId>,
underlying : Dictionary<OutputStreamId, TextWriter>,
mem : Dictionary<OutputStreamId, MemoryStream>
)
= =
inherit TextWriter () inherit TextWriter ()
override _.get_Encoding () = Encoding.Default override _.get_Encoding () = Encoding.Default
override this.Write (v : char) : unit = override this.Write (v : char) : unit =
use prev = ExecutionContext.Capture () lock
underlying
(fun _ ->
(fun () -> (fun () ->
match underlying.TryGetValue local.Value with match underlying.TryGetValue local.Value with
| true, output -> output.Write v | true, output -> output.Write v
@@ -31,16 +25,12 @@ type private ThreadAwareWriter
let wanted = let wanted =
underlying |> Seq.map (fun (KeyValue (a, b)) -> $"%O{a}") |> String.concat "\n" underlying |> Seq.map (fun (KeyValue (a, b)) -> $"%O{a}") |> String.concat "\n"
failwith $"no such context: %O{local.Value}\nwanted:\n" failwith $"no such context: %O{local.Value}\nwanted:\n{wanted}"
) )
|> lock underlying
)
|> fun action -> ExecutionContext.Run (prev, action, ())
override this.WriteLine (v : string) : unit = override this.WriteLine (v : string) : unit =
use prev = ExecutionContext.Capture () lock
underlying
(fun _ ->
(fun () -> (fun () ->
match underlying.TryGetValue local.Value with match underlying.TryGetValue local.Value with
| true, output -> output.WriteLine v | true, output -> output.WriteLine v
@@ -48,16 +38,13 @@ type private ThreadAwareWriter
let wanted = let wanted =
underlying |> Seq.map (fun (KeyValue (a, b)) -> $"%O{a}") |> String.concat "\n" underlying |> Seq.map (fun (KeyValue (a, b)) -> $"%O{a}") |> String.concat "\n"
failwith $"no such context: %O{local.Value}\nwanted:\n" failwith $"no such context: %O{local.Value}\nwanted:\n{wanted}"
) )
|> lock underlying
)
|> fun action -> ExecutionContext.Run (prev, action, ())
/// Wraps up the necessary context to intercept global state. /// Wraps up the necessary context to intercept global state.
[<NoEquality ; NoComparison>] [<NoEquality ; NoComparison>]
type TestContexts = type TestContexts =
private internal
{ {
/// Accesses to this must be locked on StdOutWriters. /// Accesses to this must be locked on StdOutWriters.
StdOuts : Dictionary<OutputStreamId, MemoryStream> StdOuts : Dictionary<OutputStreamId, MemoryStream>
@@ -77,8 +64,8 @@ type TestContexts =
let stdoutWriters = Dictionary () let stdoutWriters = Dictionary ()
let stderrWriters = Dictionary () let stderrWriters = Dictionary ()
let local = AsyncLocal () let local = AsyncLocal ()
let stdoutWriter = new ThreadAwareWriter (local, stdoutWriters, stdouts) let stdoutWriter = new ThreadAwareWriter (local, stdoutWriters)
let stderrWriter = new ThreadAwareWriter (local, stderrWriters, stderrs) let stderrWriter = new ThreadAwareWriter (local, stderrWriters)
{ {
StdOuts = stdouts StdOuts = stdouts

View File

@@ -0,0 +1,10 @@
namespace WoofWare.NUnitTestRunner
open System.Runtime.ExceptionServices
[<RequireQualifiedAccess>]
module internal Exception =
let reraiseWithOriginalStackTrace<'a> (e : exn) : 'a =
let edi = ExceptionDispatchInfo.Capture e
edi.Throw ()
failwith "unreachable"

View File

@@ -4,16 +4,16 @@ open System
open System.Threading open System.Threading
open System.Threading.Tasks open System.Threading.Tasks
type private ThunkEvaluator<'ret> = type private AsyncThunkEvaluator<'ret> =
abstract Eval<'a> : (unit -> 'a) -> AsyncReplyChannel<'a> -> 'ret abstract Eval<'a> : (unit -> Async<'a>) -> AsyncReplyChannel<Result<'a, exn>> -> 'ret
type private ThunkCrate = type private AsyncThunkCrate =
abstract Apply<'ret> : ThunkEvaluator<'ret> -> 'ret abstract Apply<'ret> : AsyncThunkEvaluator<'ret> -> 'ret
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module private ThunkCrate = module private AsyncThunkCrate =
let make<'a> (t : unit -> 'a) (rc : AsyncReplyChannel<'a>) : ThunkCrate = let make<'a> (t : unit -> Async<'a>) (rc : AsyncReplyChannel<Result<'a, exn>>) : AsyncThunkCrate =
{ new ThunkCrate with { new AsyncThunkCrate with
member _.Apply e = e.Eval t rc member _.Apply e = e.Eval t rc
} }
@@ -41,7 +41,11 @@ type private MailboxMessage =
| Quit of AsyncReplyChannel<unit> | Quit of AsyncReplyChannel<unit>
/// Check current state, see if we need to start more tests, etc. /// Check current state, see if we need to start more tests, etc.
| Reconcile | Reconcile
| RunTest of within : TestFixture * Parallelizable<unit> option * test : ThunkCrate | RunTestAsync of
within : TestFixture *
Parallelizable<unit> option *
test : AsyncThunkCrate *
context : ExecutionContext
| BeginTestFixture of TestFixture * AsyncReplyChannel<TestFixtureRunningToken> | BeginTestFixture of TestFixture * AsyncReplyChannel<TestFixtureRunningToken>
| EndTestFixture of TestFixtureTearDownToken * AsyncReplyChannel<unit> | EndTestFixture of TestFixtureTearDownToken * AsyncReplyChannel<unit>
@@ -310,21 +314,31 @@ type ParallelQueue
rc.Reply () rc.Reply ()
m.Post MailboxMessage.Reconcile m.Post MailboxMessage.Reconcile
return! processTask (Running state) m return! processTask (Running state) m
| MailboxMessage.RunTest (withinFixture, par, message) -> | MailboxMessage.RunTestAsync (withinFixture, par, message, capturedContext) ->
let t () = let t () =
{ new ThunkEvaluator<_> with { new AsyncThunkEvaluator<_> with
member _.Eval<'b> (t : unit -> 'b) rc = member _.Eval<'b> (t : unit -> Async<'b>) rc =
let tcs = TaskCompletionSource TaskCreationOptions.RunContinuationsAsynchronously let tcs = TaskCompletionSource TaskCreationOptions.RunContinuationsAsynchronously
use ec = ExecutionContext.Capture ()
fun () -> fun () ->
ExecutionContext.Run ( ExecutionContext.Run (
ec, capturedContext,
(fun _ -> (fun _ ->
let result = t () async {
tcs.SetResult () let! result =
m.Post MailboxMessage.Reconcile async {
rc.Reply result try
let! r = t ()
return Ok r
with e ->
return Error e
}
tcs.SetResult ()
m.Post MailboxMessage.Reconcile
rc.Reply result
}
|> Async.StartImmediate
), ),
() ()
) )
@@ -348,17 +362,36 @@ type ParallelQueue
let mb = new MailboxProcessor<_> (processTask MailboxState.Idle) let mb = new MailboxProcessor<_> (processTask MailboxState.Idle)
do mb.Start () do mb.Start ()
/// Request to run the given async action, freely in parallel with other running tests.
/// The resulting Task will return when the action has completed.
member _.RunAsync<'a>
(TestFixtureSetupToken parent)
(scope : Parallelizable<unit> option)
(action : unit -> Async<'a>)
: 'a Task
=
let ec = ExecutionContext.Capture ()
task {
let! result =
(fun rc -> MailboxMessage.RunTestAsync (parent, scope, AsyncThunkCrate.make action rc, ec))
|> mb.PostAndAsyncReply
|> Async.StartAsTask
match result with
| Ok o -> return o
| Error e -> return Exception.reraiseWithOriginalStackTrace e
}
/// Request to run the given action, freely in parallel with other running tests. /// Request to run the given action, freely in parallel with other running tests.
/// The resulting Task will return when the action has completed. /// The resulting Task will return when the action has completed.
member _.Run<'a> member this.Run<'a>
(TestFixtureSetupToken parent) (parent : TestFixtureSetupToken)
(scope : Parallelizable<unit> option) (scope : Parallelizable<unit> option)
(action : unit -> 'a) (action : unit -> 'a)
: 'a Task : 'a Task
= =
(fun rc -> MailboxMessage.RunTest (parent, scope, ThunkCrate.make action rc)) this.RunAsync parent scope (fun () -> async.Return (action ()))
|> mb.PostAndAsyncReply
|> Async.StartAsTask
/// Declare that we wish to start the given test fixture. The resulting Task will return /// Declare that we wish to start the given test fixture. The resulting Task will return
/// when you are allowed to start running tests from that fixture. /// when you are allowed to start running tests from that fixture.
@@ -379,11 +412,22 @@ type ParallelQueue
| Parallelizable.Yes _ -> Parallelizable.Yes () | Parallelizable.Yes _ -> Parallelizable.Yes ()
) )
let ec = ExecutionContext.Capture ()
let! response = let! response =
(fun rc -> MailboxMessage.RunTest (parent, par, ThunkCrate.make action rc)) (fun rc ->
MailboxMessage.RunTestAsync (
parent,
par,
AsyncThunkCrate.make (fun () -> async.Return (action ())) rc,
ec
)
)
|> mb.PostAndAsyncReply |> mb.PostAndAsyncReply
return response, TestFixtureSetupToken parent match response with
| Ok response -> return response, TestFixtureSetupToken parent
| Error e -> return Exception.reraiseWithOriginalStackTrace e
} }
/// Run the given one-time tear-down for the test fixture. /// Run the given one-time tear-down for the test fixture.
@@ -401,11 +445,22 @@ type ParallelQueue
| Parallelizable.Yes _ -> Parallelizable.Yes () | Parallelizable.Yes _ -> Parallelizable.Yes ()
) )
let ec = ExecutionContext.Capture ()
let! response = let! response =
(fun rc -> MailboxMessage.RunTest (parent, par, ThunkCrate.make action rc)) (fun rc ->
MailboxMessage.RunTestAsync (
parent,
par,
AsyncThunkCrate.make (fun () -> async.Return (action ())) rc,
ec
)
)
|> mb.PostAndAsyncReply |> mb.PostAndAsyncReply
return response, TestFixtureTearDownToken parent match response with
| Ok response -> return response, TestFixtureTearDownToken parent
| Error e -> return Exception.reraiseWithOriginalStackTrace e
} }
/// Declare that we have finished submitting requests to run in the given test fixture. /// Declare that we have finished submitting requests to run in the given test fixture.

View File

@@ -256,6 +256,7 @@ WoofWare.NUnitTestRunner.ParallelQueue inherit obj, implements IDisposable
WoofWare.NUnitTestRunner.ParallelQueue..ctor [constructor]: (int option, WoofWare.NUnitTestRunner.AssemblyParallelScope WoofWare.NUnitTestRunner.Parallelizable option, System.Threading.CancellationToken option) WoofWare.NUnitTestRunner.ParallelQueue..ctor [constructor]: (int option, WoofWare.NUnitTestRunner.AssemblyParallelScope WoofWare.NUnitTestRunner.Parallelizable option, System.Threading.CancellationToken option)
WoofWare.NUnitTestRunner.ParallelQueue.EndTestFixture [method]: WoofWare.NUnitTestRunner.TestFixtureTearDownToken -> unit System.Threading.Tasks.Task WoofWare.NUnitTestRunner.ParallelQueue.EndTestFixture [method]: WoofWare.NUnitTestRunner.TestFixtureTearDownToken -> unit System.Threading.Tasks.Task
WoofWare.NUnitTestRunner.ParallelQueue.Run [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> unit WoofWare.NUnitTestRunner.Parallelizable option -> (unit -> 'a) -> 'a System.Threading.Tasks.Task WoofWare.NUnitTestRunner.ParallelQueue.Run [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> unit WoofWare.NUnitTestRunner.Parallelizable option -> (unit -> 'a) -> 'a System.Threading.Tasks.Task
WoofWare.NUnitTestRunner.ParallelQueue.RunAsync [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> unit WoofWare.NUnitTestRunner.Parallelizable option -> (unit -> 'a Microsoft.FSharp.Control.FSharpAsync) -> 'a System.Threading.Tasks.Task
WoofWare.NUnitTestRunner.ParallelQueue.RunTestSetup [method]: WoofWare.NUnitTestRunner.TestFixtureRunningToken -> (unit -> 'a) -> ('a * WoofWare.NUnitTestRunner.TestFixtureSetupToken) System.Threading.Tasks.Task WoofWare.NUnitTestRunner.ParallelQueue.RunTestSetup [method]: WoofWare.NUnitTestRunner.TestFixtureRunningToken -> (unit -> 'a) -> ('a * WoofWare.NUnitTestRunner.TestFixtureSetupToken) System.Threading.Tasks.Task
WoofWare.NUnitTestRunner.ParallelQueue.RunTestTearDown [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> (unit -> 'a) -> ('a * WoofWare.NUnitTestRunner.TestFixtureTearDownToken) System.Threading.Tasks.Task WoofWare.NUnitTestRunner.ParallelQueue.RunTestTearDown [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> (unit -> 'a) -> ('a * WoofWare.NUnitTestRunner.TestFixtureTearDownToken) System.Threading.Tasks.Task
WoofWare.NUnitTestRunner.ParallelQueue.StartTestFixture [method]: WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.TestFixtureRunningToken System.Threading.Tasks.Task WoofWare.NUnitTestRunner.ParallelQueue.StartTestFixture [method]: WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.TestFixtureRunningToken System.Threading.Tasks.Task

View File

@@ -14,7 +14,7 @@
<PackageId>WoofWare.NUnitTestRunner.Lib</PackageId> <PackageId>WoofWare.NUnitTestRunner.Lib</PackageId>
<TreatWarningsAsErrors>true</TreatWarningsAsErrors> <TreatWarningsAsErrors>true</TreatWarningsAsErrors>
<WarnOn>FS3559</WarnOn> <WarnOn>FS3559</WarnOn>
<WoofWareMyriadPluginVersion>8.0.4</WoofWareMyriadPluginVersion> <WoofWareMyriadPluginVersion>8.0.5</WoofWareMyriadPluginVersion>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
@@ -31,6 +31,7 @@
<Compile Include="ParallelScope.fs" /> <Compile Include="ParallelScope.fs" />
<Compile Include="DotnetRuntime.fs" /> <Compile Include="DotnetRuntime.fs" />
<Compile Include="Array.fs" /> <Compile Include="Array.fs" />
<Compile Include="Exception.fs" />
<Compile Include="List.fs" /> <Compile Include="List.fs" />
<Compile Include="Result.fs" /> <Compile Include="Result.fs" />
<Compile Include="Domain.fs" /> <Compile Include="Domain.fs" />

View File

@@ -1,5 +1,5 @@
{ {
"version": "0.21", "version": "0.22",
"publicReleaseRefSpec": [ "publicReleaseRefSpec": [
"^refs/heads/main$" "^refs/heads/main$"
], ],
@@ -8,4 +8,4 @@
":/Directory.Build.props", ":/Directory.Build.props",
":/README.md" ":/README.md"
] ]
} }

View File

@@ -0,0 +1,396 @@
namespace WoofWare.NUnitTestRunner.Test
open System
open System.Text
open System.Threading
open System.Threading.Tasks
open NUnit.Framework
open FsUnitTyped
open WoofWare.NUnitTestRunner
[<TestFixture>]
module TestSynchronizationContext =
[<Test>]
let ``ExecutionContext flows correctly through synchronous operations`` () =
task {
let dummyFixture =
TestFixture.Empty typeof<obj> (Some (Parallelizable.Yes ClassParallelScope.All)) [] []
use contexts = TestContexts.Empty ()
use queue = new ParallelQueue (Some 4, None)
// Track which context values we see during execution
let contextValues = System.Collections.Concurrent.ConcurrentBag<Guid * Guid> ()
// Start the fixture
let! running = queue.StartTestFixture dummyFixture
let! _, setup = queue.RunTestSetup running (fun () -> ())
// Create several synchronous operations with different context values
let tasks =
[ 1..10 ]
|> List.map (fun _ ->
task {
do! Task.Yield ()
// Set a unique context value
let outputId = contexts.NewOutputs ()
let (OutputStreamId expectedId) = outputId
contexts.AsyncLocal.Value <- outputId
// Run a synchronous operation that checks the context
let! actualId =
queue.Run
setup
None
(fun () ->
// Check context immediately
let immediate = contexts.AsyncLocal.Value
let (OutputStreamId immediateGuid) = immediate
contextValues.Add (expectedId, immediateGuid)
// Do some work that might cause context issues
Thread.Sleep 10
// Check context after work
let afterWork = contexts.AsyncLocal.Value
let (OutputStreamId afterWorkGuid) = afterWork
contextValues.Add (expectedId, afterWorkGuid)
// Simulate calling into framework code that might use ExecutionContext
let mutable capturedValue = Guid.Empty
ExecutionContext.Run (
ExecutionContext.Capture (),
(fun _ ->
let current = contexts.AsyncLocal.Value
let (OutputStreamId currentGuid) = current
capturedValue <- currentGuid
),
()
)
contextValues.Add (expectedId, capturedValue)
afterWorkGuid
)
// Verify the returned value matches what we set
actualId |> shouldEqual expectedId
}
)
// Wait for all tasks
let! results = Task.WhenAll tasks
results |> Array.iter id
// Verify all context values were correct
let allValues = contextValues |> Seq.toList
allValues |> shouldHaveLength 30 // 3 checks per operation * 10 operations
// Every captured value should match its expected value
allValues
|> List.iter (fun (expected, actual) -> actual |> shouldEqual expected)
// Clean up
let! _, teardown = queue.RunTestTearDown setup (fun () -> ())
do! queue.EndTestFixture teardown
}
[<Test>]
let ``ExecutionContext isolation between concurrent synchronous operations`` () =
task {
let dummyFixture =
TestFixture.Empty typeof<obj> (Some (Parallelizable.Yes ClassParallelScope.All)) [] []
use contexts = TestContexts.Empty ()
use queue = new ParallelQueue (Some 4, None)
let! running = queue.StartTestFixture dummyFixture
let! _, setup = queue.RunTestSetup running (fun () -> ())
// Use a barrier to ensure operations run concurrently
let barrier = new Barrier (3)
let seenValues = System.Collections.Concurrent.ConcurrentBag<int * Guid> ()
let outputIds = System.Collections.Concurrent.ConcurrentBag<OutputStreamId> ()
// Create operations that will definitely run concurrently
let tasks =
[ 1..3 ]
|> List.map (fun i ->
task {
// Each task sets its own context value
let outputId = contexts.NewOutputs ()
let (OutputStreamId myId) = outputId
contexts.AsyncLocal.Value <- outputId
outputIds.Add outputId
let! result =
queue.Run
setup
(Some (Parallelizable.Yes ()))
(fun () ->
// Wait for all tasks to reach this point
barrier.SignalAndWait ()
// Now check what value we see
let currentValue = contexts.AsyncLocal.Value
match currentValue with
| OutputStreamId guid -> seenValues.Add (i, guid)
// Do some synchronous work
Thread.Sleep 5
// Check again after work
let afterWork = contexts.AsyncLocal.Value
match afterWork with
| OutputStreamId guid ->
// Also verify we can write to the correct streams
contexts.Stdout.WriteLine $"Task %i{i} sees context %O{guid}"
guid
)
// Each task should see its own value
result |> shouldEqual myId
}
)
let! results = Task.WhenAll tasks
results |> Array.iter id
// Verify we saw 3 different values (one per task)
let values = seenValues |> Seq.toList
values |> shouldHaveLength 3
// All seen values should be different (no context bleeding)
let uniqueValues = values |> List.map snd |> List.distinct
uniqueValues |> shouldHaveLength 3
let! _, teardown = queue.RunTestTearDown setup (fun () -> ())
do! queue.EndTestFixture teardown
// Verify stdout content for each task
let collectedOutputs = outputIds |> Seq.toList
collectedOutputs |> shouldHaveLength 3
for outputId in collectedOutputs do
let content = contexts.DumpStdout outputId
content |> shouldNotEqual ""
let (OutputStreamId guid) = outputId
content |> shouldContainText (guid.ToString ())
}
[<Test>]
let ``ExecutionContext flows correctly through nested synchronous operations`` () =
task {
let dummyFixture =
TestFixture.Empty typeof<obj> (Some (Parallelizable.Yes ClassParallelScope.All)) [] []
use contexts = TestContexts.Empty ()
use queue = new ParallelQueue (Some 4, None)
let! running = queue.StartTestFixture dummyFixture
let! _, setup = queue.RunTestSetup running (fun () -> ())
// Set an initial context
let outputId = contexts.NewOutputs ()
let (OutputStreamId outerGuid) = outputId
contexts.AsyncLocal.Value <- outputId
let! result =
queue.Run
setup
None
(fun () ->
// Check we have the outer context
let outer = contexts.AsyncLocal.Value
let (OutputStreamId outerSeen) = outer
outerSeen |> shouldEqual outerGuid
// Now change the context for a nested operation
let innerOutputId = contexts.NewOutputs ()
let (OutputStreamId innerGuid) = innerOutputId
contexts.AsyncLocal.Value <- innerOutputId
// Use Task.Run to potentially hop threads
let innerResult =
Task
.Run(fun () ->
let inner = contexts.AsyncLocal.Value
let (OutputStreamId innerSeen) = inner
innerSeen |> shouldEqual innerGuid
innerSeen
)
.Result
// After the nested operation, we should still have our inner context
let afterNested = contexts.AsyncLocal.Value
let (OutputStreamId afterNestedGuid) = afterNested
afterNestedGuid |> shouldEqual innerGuid
(outerSeen, innerResult, afterNestedGuid)
)
// Unpack results
let seenOuter, seenInner, seenAfter = result
seenOuter |> shouldEqual outerGuid
seenInner |> shouldNotEqual outerGuid
seenAfter |> shouldEqual seenInner
let! _, teardown = queue.RunTestTearDown setup (fun () -> ())
do! queue.EndTestFixture teardown
}
[<Test>]
let ``ExecutionContext flows correctly through async operations`` () =
task {
// Create a test fixture
let dummyFixture =
TestFixture.Empty typeof<obj> (Some (Parallelizable.Yes ClassParallelScope.All)) [] []
use contexts = TestContexts.Empty ()
use queue = new ParallelQueue (Some 4, None)
// Track which context values we see during execution
let contextValues = System.Collections.Concurrent.ConcurrentBag<Guid * Guid> ()
// Start the fixture
let! running = queue.StartTestFixture dummyFixture
let! _, setup = queue.RunTestSetup running (fun () -> ())
// Create several async operations with different context values
let tasks =
[ 1..10 ]
|> List.map (fun i ->
task {
// Set a unique context value
let expectedId = Guid.NewGuid ()
let outputId = OutputStreamId expectedId
contexts.AsyncLocal.Value <- outputId
// Run an async operation that checks the context at multiple points
let! actualId =
queue.RunAsync
setup
None
(fun () ->
async {
// Check context immediately
let immediate = contexts.AsyncLocal.Value
let (OutputStreamId immediateGuid) = immediate
contextValues.Add (expectedId, immediateGuid)
// Yield to allow potential context loss
do! Async.Sleep 10
// Check context after yield
let afterYield = contexts.AsyncLocal.Value
let (OutputStreamId afterYieldGuid) = afterYield
contextValues.Add (expectedId, afterYieldGuid)
// Do some actual async work
do! Task.Delay (10) |> Async.AwaitTask
// Check context after task
let afterTask = contexts.AsyncLocal.Value
let (OutputStreamId afterTaskGuid) = afterTask
contextValues.Add (expectedId, afterTaskGuid)
return afterTaskGuid
}
)
// Verify the returned value matches what we set
actualId |> shouldEqual expectedId
}
)
// Wait for all tasks
let! results = Task.WhenAll (tasks)
results |> Array.iter id
// Verify all context values were correct
let allValues = contextValues |> Seq.toList
allValues |> shouldHaveLength 30 // 3 checks per operation * 10 operations
// Every captured value should match its expected value
allValues
|> List.iter (fun (expected, actual) -> actual |> shouldEqual expected)
// Clean up
let! _, teardown = queue.RunTestTearDown setup (fun () -> ())
do! queue.EndTestFixture teardown
}
[<Test>]
let ``ExecutionContext isolation between concurrent operations`` () =
task {
let dummyFixture =
TestFixture.Empty typeof<obj> (Some (Parallelizable.Yes ClassParallelScope.All)) [] []
use contexts = TestContexts.Empty ()
use queue = new ParallelQueue (Some 4, None)
let! running = queue.StartTestFixture dummyFixture
let! _, setup = queue.RunTestSetup running (fun () -> ())
// Use a barrier to ensure operations run concurrently
let barrier = new Barrier (3)
let seenValues = System.Collections.Concurrent.ConcurrentBag<int * Guid> ()
// Create operations that will definitely run concurrently
let tasks =
[ 1..3 ]
|> List.map (fun i ->
task {
// Each task sets its own context value
let myId = Guid.NewGuid ()
contexts.AsyncLocal.Value <- OutputStreamId myId
let! result =
queue.RunAsync
setup
(Some (Parallelizable.Yes ()))
(fun () ->
async {
// Wait for all tasks to reach this point
barrier.SignalAndWait () |> ignore
// Now check what value we see
let currentValue = contexts.AsyncLocal.Value
match currentValue with
| OutputStreamId guid -> seenValues.Add (i, guid)
// Do some async work
do! Async.Sleep 5
// Check again after async work
let afterAsync = contexts.AsyncLocal.Value
match afterAsync with
| OutputStreamId guid -> return guid
}
)
// Each task should see its own value
result |> shouldEqual myId
}
)
let! results = Task.WhenAll (tasks)
results |> Array.iter id
// Verify we saw 3 different values (one per task)
let values = seenValues |> Seq.toList
values |> shouldHaveLength 3
// All seen values should be different (no context bleeding)
let uniqueValues = values |> List.map snd |> List.distinct
uniqueValues |> shouldHaveLength 3
let! _, teardown = queue.RunTestTearDown setup (fun () -> ())
do! queue.EndTestFixture teardown
}

View File

@@ -11,14 +11,15 @@
<Compile Include="TestFilter.fs" /> <Compile Include="TestFilter.fs" />
<Compile Include="TestList.fs" /> <Compile Include="TestList.fs" />
<Compile Include="TestSurface.fs" /> <Compile Include="TestSurface.fs" />
<Compile Include="TestSynchronizationContext.fs" />
<Compile Include="TestTrx.fs" /> <Compile Include="TestTrx.fs" />
<EmbeddedResource Include="Example1.trx" /> <EmbeddedResource Include="Example1.trx" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="ApiSurface" Version="4.1.21" /> <PackageReference Include="ApiSurface" Version="4.1.22" />
<PackageReference Include="FsCheck" Version="3.3.0" /> <PackageReference Include="FsCheck" Version="3.3.0" />
<PackageReference Include="FsUnit" Version="7.0.1" /> <PackageReference Include="FsUnit" Version="7.1.1" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1" /> <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1" />
<PackageReference Include="NUnit" Version="4.3.2" /> <PackageReference Include="NUnit" Version="4.3.2" />
<PackageReference Include="NUnit3TestAdapter" Version="5.0.0"/> <PackageReference Include="NUnit3TestAdapter" Version="5.0.0"/>

View File

@@ -10,7 +10,7 @@
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.15.0]" /> <PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.17.0]" />
</ItemGroup> </ItemGroup>
</Project> </Project>

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
}, },
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1750386251, "lastModified": 1753432016,
"narHash": "sha256-1ovgdmuDYVo5OUC5NzdF+V4zx2uT8RtsgZahxidBTyw=", "narHash": "sha256-cnL5WWn/xkZoyH/03NNUS7QgW5vI7D1i74g48qplCvg=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "076e8c6678d8c54204abcb4b1b14c366835a58bb", "rev": "6027c30c8e9810896b92429f0092f624f7b1aace",
"type": "github" "type": "github"
}, },
"original": { "original": {

View File

@@ -1,13 +1,13 @@
[ [
{ {
"pname": "ApiSurface", "pname": "ApiSurface",
"version": "4.1.21", "version": "4.1.22",
"hash": "sha256-v2adBYoE9NZPaQR3u2qq9r/9PxAM/wqi2Uiky0xGq+E=" "hash": "sha256-voj9m3YmyJ95FAMLV4sWzQMod3Em0mTjzf0LBUUFOso="
}, },
{ {
"pname": "fantomas", "pname": "fantomas",
"version": "7.0.2", "version": "7.0.3",
"hash": "sha256-BAaENIm/ksTiXrUImRgKoIXTGIlgsX7ch6ayoFjhJXA=" "hash": "sha256-0XlfV7SxXPDnk/CjkUesJSaH0cxlNHJ+Jj86zNUhkNA="
}, },
{ {
"pname": "Fantomas.Core", "pname": "Fantomas.Core",
@@ -26,8 +26,8 @@
}, },
{ {
"pname": "fsharp-analyzers", "pname": "fsharp-analyzers",
"version": "0.31.0", "version": "0.32.0",
"hash": "sha256-PoAvaXbXsmvVw870UsnqdD20HoBHO7u4bzoaz5DXfzM=" "hash": "sha256-MnhsK5tOeexL6uQhsV4nTRz8CGbz2o8VyHwAK8x91pE="
}, },
{ {
"pname": "FSharp.Core", "pname": "FSharp.Core",
@@ -41,8 +41,8 @@
}, },
{ {
"pname": "FsUnit", "pname": "FsUnit",
"version": "7.0.1", "version": "7.1.1",
"hash": "sha256-K85CIdxMeFSHEKZk6heIXp/oFjWAn7dBILKrw49pJUY=" "hash": "sha256-UMCEGKxQ4ytjmPuVpiNaAPbi3RQH9gqa61JJIUS/6hg="
}, },
{ {
"pname": "Microsoft.ApplicationInsights", "pname": "Microsoft.ApplicationInsights",
@@ -366,13 +366,13 @@
}, },
{ {
"pname": "WoofWare.Myriad.Plugins", "pname": "WoofWare.Myriad.Plugins",
"version": "8.0.4", "version": "8.0.5",
"hash": "sha256-/cX7B1QDOnyYRaetl1pQRkeVNLA7vP25TJfBZhi2j/c=" "hash": "sha256-IfTT2GM9ktUW5BQoKQGFKK39BAKeziJJnrOIL7Vs19o="
}, },
{ {
"pname": "WoofWare.Myriad.Plugins.Attributes", "pname": "WoofWare.Myriad.Plugins.Attributes",
"version": "3.6.11", "version": "3.6.12",
"hash": "sha256-UI8wT1a3CuQUeXb1qIHCiimGJ1qBjK9ZOQN2/N5fNdg=" "hash": "sha256-90uiVtc5exCbkcdS8DgTmlEZZT8/AdrY0QuFzy+FHUo="
}, },
{ {
"pname": "WoofWare.PrattParser", "pname": "WoofWare.PrattParser",