Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 13 additions & 1 deletion src/Compiler/Facilities/BuildGraph.fs
Original file line number Diff line number Diff line change
Expand Up @@ -193,7 +193,19 @@ type NodeCode private () =
}

static member Parallel(computations: NodeCode<'T> seq) =
computations |> Seq.map (fun (Node x) -> x) |> Async.Parallel |> Node
let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger
let phase = DiagnosticsThreadStatics.BuildPhase

computations
|> Seq.map (fun (Node x) ->
async {
DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is not safe, as the logger we're passing is most probably not thread-safe. So we're betting on the computation to actually never use it.

DiagnosticsThreadStatics.BuildPhase <- phase
return! x
})
|> Async.Parallel
|> wrapThreadStaticInfo
|> Node

[<RequireQualifiedAccess>]
module GraphNode =
Expand Down
40 changes: 40 additions & 0 deletions tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ open Xunit
open FSharp.Test
open FSharp.Test.Compiler
open FSharp.Compiler.BuildGraph
open FSharp.Compiler.DiagnosticsLogger
open Internal.Utilities.Library

module BuildGraphTests =
Expand Down Expand Up @@ -233,3 +234,42 @@ module BuildGraphTests =

Assert.shouldBeTrue graphNode.HasValue
Assert.shouldBe (ValueSome 1) (graphNode.TryPeekValue())


[<Fact>]
let internal ``NodeCode preserves DiagnosticsThreadStatics`` () =
let random =
let rng = Random()
fun n -> rng.Next n

let job phase _ = node {
do! random 10 |> Async.Sleep |> NodeCode.AwaitAsync
Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase)
}

let work (phase: BuildPhase) =
node {
use _ = new CompilationGlobalsScope(DiscardErrorsLogger, phase)
let! _ = Seq.init 8 (job phase) |> NodeCode.Parallel
Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase)
}

let phases = [|
BuildPhase.DefaultPhase
BuildPhase.Compile
BuildPhase.Parameter
BuildPhase.Parse
BuildPhase.TypeCheck
BuildPhase.CodeGen
BuildPhase.Optimize
BuildPhase.IlxGen
BuildPhase.IlGen
BuildPhase.Output
BuildPhase.Interactive
|]

let pickRandomPhase _ = phases[random phases.Length]
Seq.init 100 pickRandomPhase
|> Seq.map (work >> Async.AwaitNodeCode)
|> Async.Parallel
|> Async.RunSynchronously