From c3a6b0fb47c10ae22846a24112c57c964fb5d6b6 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 16 Jan 2024 14:59:37 +0100 Subject: [PATCH 01/35] Improve AsyncMemoize tests --- .../CompilerService/AsyncMemoize.fs | 86 +++++++++---------- 1 file changed, 42 insertions(+), 44 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 817a3b8c70a..920a2a58cb7 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -11,28 +11,21 @@ open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Diagnostics open FSharp.Compiler.BuildGraph -[] -let ``Stack trace`` () = - let memoize = AsyncMemoize() +let timeout = TimeSpan.FromSeconds 10 - let computation key = node { - // do! Async.Sleep 1 |> NodeCode.AwaitAsync +let waitFor (mre: ManualResetEvent) = + if not <| mre.WaitOne timeout then + failwith "waitFor timed out" - let! result = memoize.Get'(key * 2, node { - //do! Async.Sleep 1 |> NodeCode.AwaitAsync - return key * 5 - }) - return result * 2 +let rec internal spinFor (duration: TimeSpan) = + node { + let sw = Stopwatch.StartNew() + do! Async.Sleep 10 |> NodeCode.AwaitAsync + return! spinFor (duration - sw.Elapsed) } - //let _r2 = computation 10 - - let result = memoize.Get'(1, computation 1) |> NodeCode.RunImmediateWithoutCancellation - - Assert.Equal(10, result) - [] let ``Basics``() = @@ -74,16 +67,21 @@ let ``We can cancel a job`` () = let jobStarted = new ManualResetEvent(false) - let computation key = node { - jobStarted.Set() |> ignore - do! Async.Sleep 1000 |> NodeCode.AwaitAsync + let jobCanceled = new ManualResetEvent(false) + + let computation action = node { + action() |> ignore + do! spinFor timeout failwith "Should be canceled before it gets here" - return key * 2 } let eventLog = ResizeArray() - let memoize = AsyncMemoize() - memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Add (e, k)) + let memoize = AsyncMemoize() + memoize.OnEvent(fun (e, (_label, k, _version)) -> + eventLog.Add (e, k) + if e = Canceled then + jobCanceled.Set() |> ignore + ) use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -91,26 +89,22 @@ let ``We can cancel a job`` () = let key = 1 - let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) + let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation jobStarted.Set), ct = cts1.Token) - jobStarted.WaitOne() |> ignore + waitFor jobStarted jobStarted.Reset() |> ignore - let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) - let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) - - Assert.Equal<(JobEvent * int) array>([| Started, key |], eventLog |> Seq.toArray ) - - do! Task.Delay 100 + let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation ignore), ct = cts2.Token) + let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation ignore), ct = cts3.Token) cts1.Cancel() cts2.Cancel() - do! Task.Delay 100 + waitFor jobStarted cts3.Cancel() - do! Task.Delay 100 + waitFor jobCanceled Assert.Equal<(JobEvent * int) array>([| Started, key; Started, key; Canceled, key |], eventLog |> Seq.toArray ) } @@ -120,12 +114,11 @@ let ``Job is restarted if first requestor cancels`` () = task { let jobStarted = new ManualResetEvent(false) + let jobCanComplete = new ManualResetEvent(false) + let computation key = node { jobStarted.Set() |> ignore - - for _ in 1 .. 5 do - do! Async.Sleep 100 |> NodeCode.AwaitAsync - + waitFor jobCanComplete return key * 2 } @@ -140,18 +133,21 @@ let ``Job is restarted if first requestor cancels`` () = let key = 1 let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) - jobStarted.WaitOne() |> ignore + + waitFor jobStarted + jobStarted.Reset() |> ignore let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) - do! Task.Delay 100 - cts1.Cancel() - do! Task.Delay 100 + waitFor jobStarted + cts3.Cancel() + jobCanComplete.Set() |> ignore + let! result = _task2 Assert.Equal(2, result) @@ -216,12 +212,11 @@ let ``Job is restarted if first requestor cancels but keeps running if second re task { let jobStarted = new ManualResetEvent(false) + let jobCanComplete = new ManualResetEvent(false) + let computation key = node { jobStarted.Set() |> ignore - - for _ in 1 .. 5 do - do! Async.Sleep 100 |> NodeCode.AwaitAsync - + waitFor jobCanComplete return key * 2 } @@ -239,6 +234,7 @@ let ``Job is restarted if first requestor cancels but keeps running if second re jobStarted.WaitOne() |> ignore jobStarted.Reset() |> ignore + let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) @@ -248,6 +244,8 @@ let ``Job is restarted if first requestor cancels but keeps running if second re cts2.Cancel() + jobCanComplete.Set() |> ignore + let! result = _task3 Assert.Equal(2, result) From de170ae939f7fe6ccdd82708926237dd93562a13 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 16 Jan 2024 15:59:20 +0100 Subject: [PATCH 02/35] relax test condition --- .../CompilerService/AsyncMemoize.fs | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 920a2a58cb7..404d4f3213e 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -249,8 +249,6 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let! result = _task3 Assert.Equal(2, result) - Assert.Equal(TaskStatus.Canceled, _task1.Status) - let orderedLog = eventLog |> Seq.sortBy fst |> Seq.map snd |> Seq.toList let expected = [ Started, key; Started, key; Finished, key ] From af8fc6a7452cf59ca13e475ec66dac9ffb0777bc Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 16 Jan 2024 16:19:51 +0100 Subject: [PATCH 03/35] Revert "Cancellable: set token from node/async in features code (#16348)" This reverts commit d4e3b26c7738444fa21092e76e77ff3e21c63006. --- src/Compiler/Facilities/BuildGraph.fs | 8 ----- src/Compiler/Interactive/fsi.fs | 3 -- src/Compiler/Service/BackgroundCompiler.fs | 28 --------------- src/Compiler/Service/FSharpCheckerResults.fs | 3 -- src/Compiler/Service/service.fs | 6 ---- src/Compiler/Utilities/Cancellable.fs | 38 ++++++++++++++------ src/Compiler/Utilities/Cancellable.fsi | 1 - 7 files changed, 27 insertions(+), 60 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 8927862c23c..1df58c1024b 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -17,14 +17,12 @@ let wrapThreadStaticInfo computation = async { let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase - let ct = Cancellable.Token try return! computation finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct } type Async<'T> with @@ -127,7 +125,6 @@ type NodeCode private () = static member RunImmediate(computation: NodeCode<'T>, ct: CancellationToken) = let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase - let ct2 = Cancellable.Token try try @@ -135,7 +132,6 @@ type NodeCode private () = async { DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct2 return! computation |> Async.AwaitNodeCode } @@ -143,7 +139,6 @@ type NodeCode private () = finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct2 with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> raise (ex.InnerExceptions[0]) @@ -153,14 +148,12 @@ type NodeCode private () = static member StartAsTask_ForTesting(computation: NodeCode<'T>, ?ct: CancellationToken) = let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase - let ct2 = Cancellable.Token try let work = async { DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct2 return! computation |> Async.AwaitNodeCode } @@ -168,7 +161,6 @@ type NodeCode private () = finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct2 static member CancellationToken = cancellationToken diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index ca0e2335064..e5ff5b6c754 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4089,7 +4089,6 @@ type FsiInteractionProcessor ?cancellationToken: CancellationToken ) = let cancellationToken = defaultArg cancellationToken CancellationToken.None - use _ = Cancellable.UsingToken(cancellationToken) if tokenizer.LexBuffer.IsPastEndOfStream then let stepStatus = @@ -4218,7 +4217,6 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, diagnosticsLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None - use _ = Cancellable.UsingToken(cancellationToken) use _ = UseBuildPhase BuildPhase.Interactive use _ = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID @@ -4895,7 +4893,6 @@ type FsiEvaluationSession SpawnInteractiveServer(fsi, fsiOptions, fsiConsoleOutput) use _ = UseBuildPhase BuildPhase.Interactive - use _ = Cancellable.UsingToken(CancellationToken.None) if fsiOptions.Interact then // page in the type check env diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index 514bb8e45c5..f9f952dde70 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -574,9 +574,6 @@ type internal BackgroundCompiler Activity.Tags.cache, cache.ToString() |] - let! ct = Async.CancellationToken - use _ = Cancellable.UsingToken(ct) - if cache then let hash = sourceText.GetHashCode() |> int64 @@ -629,9 +626,6 @@ type internal BackgroundCompiler "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -783,9 +777,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! cachedResults = node { let! builderOpt, creationDiags = getAnyBuilder (options, userOpName) @@ -846,9 +837,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -897,9 +885,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -969,9 +954,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -991,9 +973,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -1134,9 +1113,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -1185,8 +1161,6 @@ type internal BackgroundCompiler /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) member private _.ParseAndCheckProjectImpl(options, userOpName) = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -1452,8 +1426,6 @@ type internal BackgroundCompiler |] async { - let! ct = Async.CancellationToken - use _ = Cancellable.UsingToken(ct) let! ct = Async.CancellationToken // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 48b9875c9f0..5f18a90968a 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -3585,9 +3585,6 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal member _.ParseAndCheckInteraction(sourceText: ISourceText, ?userOpName: string) = cancellable { - let! ct = Cancellable.token () - use _ = Cancellable.UsingToken(ct) - let userOpName = defaultArg userOpName "Unknown" let fileName = Path.Combine(tcConfig.implicitIncludeDir, "stdin.fsx") let suggestNamesForErrors = true // Will always be true, this is just for readability diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index b79254d7935..492ff2da497 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -348,9 +348,6 @@ type FSharpChecker use _ = Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] async { - let! ct = Async.CancellationToken - use _ = Cancellable.UsingToken(ct) - let ctok = CompilationThreadToken() return CompileHelpers.compileFromArgs (ctok, argv, legacyReferenceResolver, None, None) } @@ -485,9 +482,6 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - if fastCheck <> Some true || not captureIdentifiersWhenParsing then return! backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) else diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index c702e3b7a0b..59e7def4c10 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -2,32 +2,47 @@ namespace FSharp.Compiler open System open System.Threading +open Internal.Utilities.Library [] type Cancellable = [] - static val mutable private token: CancellationToken - - static member UsingToken(ct) = - let oldCt = Cancellable.token - - Cancellable.token <- ct + static val mutable private tokens: CancellationToken list + static let disposable = { new IDisposable with - member this.Dispose() = Cancellable.token <- oldCt + member this.Dispose() = + Cancellable.Tokens <- Cancellable.Tokens |> List.tail } - static member Token - with get () = Cancellable.token - and internal set v = Cancellable.token <- v + static member Tokens + with private get () = + match box Cancellable.tokens with + | Null -> [] + | _ -> Cancellable.tokens + and private set v = Cancellable.tokens <- v + + static member UsingToken(ct) = + Cancellable.Tokens <- ct :: Cancellable.Tokens + disposable + + static member Token = + match Cancellable.Tokens with + | [] -> CancellationToken.None + | token :: _ -> token + /// There may be multiple tokens if `UsingToken` is called multiple times, producing scoped structure. + /// We're interested in the current, i.e. the most recent, one. static member CheckAndThrow() = - Cancellable.token.ThrowIfCancellationRequested() + match Cancellable.Tokens with + | [] -> () + | token :: _ -> token.ThrowIfCancellationRequested() namespace Internal.Utilities.Library open System open System.Threading +open FSharp.Compiler #if !FSHARPCORE_USE_PACKAGE open FSharp.Core.CompilerServices.StateMachineHelpers @@ -48,6 +63,7 @@ module Cancellable = ValueOrCancelled.Cancelled(OperationCanceledException ct) else try + use _ = Cancellable.UsingToken(ct) oper ct with :? OperationCanceledException as e -> ValueOrCancelled.Cancelled(OperationCanceledException e.CancellationToken) diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 6e36d7ecb6d..23515432bdd 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -7,7 +7,6 @@ open System.Threading type Cancellable = static member internal UsingToken: CancellationToken -> IDisposable static member Token: CancellationToken - static member internal Token: CancellationToken with set static member CheckAndThrow: unit -> unit namespace Internal.Utilities.Library From 0a9f7287f598cba826d30ef2c6275e3ca68bcb1c Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Tue, 16 Jan 2024 18:02:21 +0100 Subject: [PATCH 04/35] remove UsingToken --- src/Compiler/Facilities/AsyncMemoize.fs | 3 +-- src/Compiler/Service/TransparentCompiler.fs | 2 -- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index ad798140cb9..8309eaa1c15 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -346,7 +346,6 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T try // TODO: Should unify starting and restarting - use _ = Cancellable.UsingToken(cts.Token) log (Started, key) Interlocked.Increment &restarted |> ignore System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" @@ -498,7 +497,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T // TODO: Should unify starting and restarting let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger - use _ = Cancellable.UsingToken(internalCt) + log (Started, key) try diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index fe82627483f..ad0091d214b 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1762,8 +1762,6 @@ type internal TransparentCompiler node { //use _ = // Activity.start "ParseFile" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) // TODO: might need to deal with exceptions here: let tcConfigB, sourceFileNames, _ = ComputeTcConfigBuilder projectSnapshot From a03215e500ce7c5e11291292ec97405c99b6c0e6 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Tue, 16 Jan 2024 18:36:43 +0100 Subject: [PATCH 05/35] remove UsingToken --- src/Compiler/Service/TransparentCompiler.fs | 33 --------------------- 1 file changed, 33 deletions(-) diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index ad0091d214b..0d2822eadb2 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1816,9 +1816,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText) |> NodeCode.AwaitAsync @@ -1840,9 +1837,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText) |> NodeCode.AwaitAsync @@ -1895,9 +1889,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode> = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - ignore canInvalidateProject let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync @@ -1912,9 +1903,6 @@ type internal TransparentCompiler member this.GetAssemblyData(options: FSharpProjectOptions, fileName, userOpName: string) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync return! this.GetAssemblyData(snapshot.ProjectSnapshot, fileName, userOpName) } @@ -1934,9 +1922,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync match! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, userOpName) with @@ -1951,9 +1936,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync return! this.ParseFile(fileName, snapshot.ProjectSnapshot, userOpName) } @@ -1967,9 +1949,6 @@ type internal TransparentCompiler ) : NodeCode<(FSharpParseFileResults * FSharpCheckFileResults) option> = node { ignore builder - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, 1, sourceText) |> NodeCode.AwaitAsync @@ -2021,9 +2000,6 @@ type internal TransparentCompiler ) : NodeCode = node { ignore userOpName - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync return! ComputeSemanticClassification(fileName, snapshot.ProjectSnapshot) } @@ -2046,9 +2022,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText) |> NodeCode.AwaitAsync @@ -2061,9 +2034,6 @@ type internal TransparentCompiler member this.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - ignore userOpName let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync return! ComputeParseAndCheckProject snapshot.ProjectSnapshot @@ -2071,9 +2041,6 @@ type internal TransparentCompiler member this.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - ignore userOpName return! ComputeParseAndCheckProject projectSnapshot.ProjectSnapshot } From 2ad0e812bcf5975ec284152678cb76b63cf86f1a Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Tue, 16 Jan 2024 20:06:19 +0100 Subject: [PATCH 06/35] test improvement --- src/Compiler/Service/TransparentCompiler.fs | 1 + .../CompilerService/AsyncMemoize.fs | 16 ++++++++-------- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 0d2822eadb2..298c0e6b627 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1949,6 +1949,7 @@ type internal TransparentCompiler ) : NodeCode<(FSharpParseFileResults * FSharpCheckFileResults) option> = node { ignore builder + let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, 1, sourceText) |> NodeCode.AwaitAsync diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 404d4f3213e..7344a45c835 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -122,9 +122,9 @@ let ``Job is restarted if first requestor cancels`` () = return key * 2 } - let eventLog = ConcurrentBag() - let memoize = AsyncMemoize() - memoize.OnEvent(fun (e, (_, k, _version)) -> eventLog.Add (DateTime.Now.Ticks, (e, k))) + let eventLog = ConcurrentStack() + let memoize = AsyncMemoize() + memoize.OnEvent(fun (e, (_, k, _version)) -> eventLog.Push (e, k)) use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -153,7 +153,7 @@ let ``Job is restarted if first requestor cancels`` () = Assert.Equal(TaskStatus.Canceled, _task1.Status) - let orderedLog = eventLog |> Seq.sortBy fst |> Seq.map snd |> Seq.toList + let orderedLog = eventLog |> Seq.rev |> Seq.toList let expected = [ Started, key; Started, key; Finished, key ] Assert.Equal<_ list>(expected, orderedLog) @@ -220,9 +220,9 @@ let ``Job is restarted if first requestor cancels but keeps running if second re return key * 2 } - let eventLog = ConcurrentBag() - let memoize = AsyncMemoize() - memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Add (DateTime.Now.Ticks, (e, k))) + let eventLog = ConcurrentStack() + let memoize = AsyncMemoize() + memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Push (e, k)) use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -249,7 +249,7 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let! result = _task3 Assert.Equal(2, result) - let orderedLog = eventLog |> Seq.sortBy fst |> Seq.map snd |> Seq.toList + let orderedLog = eventLog |> Seq.rev |> Seq.toList let expected = [ Started, key; Started, key; Finished, key ] Assert.Equal<_ list>(expected, orderedLog) From 5bdae1720ef12190ae66f7ec96dd4473fd6ae4f5 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Tue, 16 Jan 2024 20:09:14 +0100 Subject: [PATCH 07/35] test improvement --- .../CompilerService/AsyncMemoize.fs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 404d4f3213e..7344a45c835 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -122,9 +122,9 @@ let ``Job is restarted if first requestor cancels`` () = return key * 2 } - let eventLog = ConcurrentBag() - let memoize = AsyncMemoize() - memoize.OnEvent(fun (e, (_, k, _version)) -> eventLog.Add (DateTime.Now.Ticks, (e, k))) + let eventLog = ConcurrentStack() + let memoize = AsyncMemoize() + memoize.OnEvent(fun (e, (_, k, _version)) -> eventLog.Push (e, k)) use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -153,7 +153,7 @@ let ``Job is restarted if first requestor cancels`` () = Assert.Equal(TaskStatus.Canceled, _task1.Status) - let orderedLog = eventLog |> Seq.sortBy fst |> Seq.map snd |> Seq.toList + let orderedLog = eventLog |> Seq.rev |> Seq.toList let expected = [ Started, key; Started, key; Finished, key ] Assert.Equal<_ list>(expected, orderedLog) @@ -220,9 +220,9 @@ let ``Job is restarted if first requestor cancels but keeps running if second re return key * 2 } - let eventLog = ConcurrentBag() - let memoize = AsyncMemoize() - memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Add (DateTime.Now.Ticks, (e, k))) + let eventLog = ConcurrentStack() + let memoize = AsyncMemoize() + memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Push (e, k)) use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -249,7 +249,7 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let! result = _task3 Assert.Equal(2, result) - let orderedLog = eventLog |> Seq.sortBy fst |> Seq.map snd |> Seq.toList + let orderedLog = eventLog |> Seq.rev |> Seq.toList let expected = [ Started, key; Started, key; Finished, key ] Assert.Equal<_ list>(expected, orderedLog) From f3f455909791277af0d487cb7cb43b3c5840557b Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 17 Jan 2024 10:41:21 +0100 Subject: [PATCH 08/35] Task.Yield --- src/Compiler/Facilities/AsyncMemoize.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 8309eaa1c15..f005eb1f6b8 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -308,7 +308,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let processStateUpdate post (key: KeyData<_, _>, action: StateUpdate<_>) = task { - do! Task.Delay 0 + do! Task.Yield() do! lock.Do(fun () -> From 4a121032afae245913ad444163972fdd4fc0e441 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 10:50:57 +0100 Subject: [PATCH 09/35] relax test condition --- .../CompilerService/AsyncMemoize.fs | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 7344a45c835..92dda5bd044 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -151,8 +151,6 @@ let ``Job is restarted if first requestor cancels`` () = let! result = _task2 Assert.Equal(2, result) - Assert.Equal(TaskStatus.Canceled, _task1.Status) - let orderedLog = eventLog |> Seq.rev |> Seq.toList let expected = [ Started, key; Started, key; Finished, key ] From 8ee674cf3dc300bd2a9cdebee3a8b58f565830d1 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 10:51:55 +0100 Subject: [PATCH 10/35] relax test condition --- .../CompilerService/AsyncMemoize.fs | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 7344a45c835..92dda5bd044 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -151,8 +151,6 @@ let ``Job is restarted if first requestor cancels`` () = let! result = _task2 Assert.Equal(2, result) - Assert.Equal(TaskStatus.Canceled, _task1.Status) - let orderedLog = eventLog |> Seq.rev |> Seq.toList let expected = [ Started, key; Started, key; Finished, key ] From c1fb312ffed899906475708dafdb198b2a0d8b68 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 17 Jan 2024 10:54:57 +0100 Subject: [PATCH 11/35] unindent a bit --- src/Compiler/Facilities/AsyncMemoize.fs | 494 ++++++++++++------------ 1 file changed, 243 insertions(+), 251 deletions(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index f005eb1f6b8..732915d7774 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -7,7 +7,6 @@ open System.IO open System.Threading open System.Threading.Tasks -open FSharp.Compiler open FSharp.Compiler.BuildGraph open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger @@ -113,14 +112,24 @@ type internal AsyncLock() = member _.Semaphore = semaphore - member _.Do(f) = + member _.Gate() = task { do! semaphore.WaitAsync() - try - return! f () - finally - semaphore.Release() |> ignore + return + { new IDisposable with + member _.Dispose() = + try + semaphore.Release() |> ignore + with :? ObjectDisposedException -> + () + } + } + + member this.Do(f) = + task { + use! _gate = this.Gate() + return! f () } interface IDisposable with @@ -238,223 +247,241 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let lock = new AsyncLock() - let processRequest post (key: KeyData<_, _>, msg) diagnosticLogger = - - lock.Do(fun () -> - task { - - let cached, otherVersions = cache.GetAll(key.Key, key.Version) - - return - match msg, cached with - | GetOrCompute _, Some(Completed(result, diags)) -> - Interlocked.Increment &hits |> ignore - diags |> replayDiagnostics diagnosticLogger - Existing(Task.FromResult result) - | GetOrCompute(_, ct), Some(Running(tcs, _, _, _, loggers)) -> - Interlocked.Increment &hits |> ignore - incrRequestCount key - - ct.Register(fun _ -> - let _name = name - Interlocked.Increment &cancel_ct_registration_subsequent |> ignore - post (key, CancelRequest)) - |> saveRegistration key - - loggers.Add diagnosticLogger - - Existing tcs.Task - - | GetOrCompute(computation, ct), None - | GetOrCompute(computation, ct), Some(Job.Canceled _) - | GetOrCompute(computation, ct), Some(Job.Failed _) -> - Interlocked.Increment &started |> ignore - incrRequestCount key - - ct.Register(fun _ -> - let _name = name - Interlocked.Increment &cancel_ct_registration_original |> ignore - post (key, OriginatorCanceled)) - |> saveRegistration key - - let cts = new CancellationTokenSource() - - cache.Set( - key.Key, - key.Version, - key.Label, - (Running(TaskCompletionSource(), cts, computation, DateTime.Now, ResizeArray())) - ) - - otherVersions - |> Seq.choose (function - | v, Running(_tcs, cts, _, _, _) -> Some(v, cts) - | _ -> None) - |> Seq.iter (fun (_v, cts) -> - use _ = Activity.start $"{name}: Duplicate running job" [| "key", key.Label |] - //System.Diagnostics.Trace.TraceWarning($"{name} Duplicate {key.Label}") - if cancelDuplicateRunningJobs then - //System.Diagnostics.Trace.TraceWarning("Canceling") - cts.Cancel()) - - New cts.Token - }) - let internalError key message = let ex = exn (message) failures.Add(key, ex) Interlocked.Increment &errors |> ignore // raise ex -- Suppose there's no need to raise here - where does it even go? - let processStateUpdate post (key: KeyData<_, _>, action: StateUpdate<_>) = + let compute computation ct = + Async.StartImmediateAsTask(Async.AwaitNodeCode computation, cancellationToken = ct) + + let rec post msg = processStateUpdate msg |> ignore + + // TODO: Should unify starting and restarting + and start key computation ct loggerOpt = + task { + let cachingLogger = new CachingDiagnosticsLogger(loggerOpt) + + try + let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger + log (Started, key) + + try + let! result = compute computation ct + post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) + return result + finally + DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger + with + | TaskCancelled ex -> + // TODO: do we need to do anything else here? Presumably it should be done by the registration on + // the cancellation token or before we triggered our own cancellation + + // Let's send this again just in case. It seems sometimes it's not triggered from the registration? + + Interlocked.Increment &cancel_exception_original |> ignore + + post (key, (OriginatorCanceled)) + return raise ex + | ex -> + post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) + return raise ex + } + + and restart key computation ct loggerOpt = + task { + let cachingLogger = new CachingDiagnosticsLogger(loggerOpt) + + try + let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger + log (Started, key) + + Interlocked.Increment &restarted |> ignore + System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" + + try + let! result = compute computation ct + post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) + finally + DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger + with + | TaskCancelled _ -> + Interlocked.Increment &cancel_exception_subsequent |> ignore + post (key, CancelRequest) + () + | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) + } + + and processStateUpdate (key: KeyData<_, _>, action: StateUpdate<_>) = task { do! Task.Yield() + use! _gate = lock.Gate() + + let cached = cache.TryGet(key.Key, key.Version) + + match action, cached with + + | OriginatorCanceled, Some(Running(tcs, cts, computation, _, _)) -> - do! - lock.Do(fun () -> - task { - - let cached = cache.TryGet(key.Key, key.Version) - - match action, cached with - - | OriginatorCanceled, Some(Running(tcs, cts, computation, _, _)) -> - - Interlocked.Increment &cancel_original_processed |> ignore - - decrRequestCount key - - if requestCounts[key] < 1 then - cancelRegistration key - cts.Cancel() - tcs.TrySetCanceled() |> ignore - // Remember the job in case it completes after cancellation - cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) - requestCounts.Remove key |> ignore - log (Canceled, key) - Interlocked.Increment &canceled |> ignore - use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] - () - - else - // We need to restart the computation - Task.Run(fun () -> - Async.StartAsTask( - async { - - let cachingLogger = new CachingDiagnosticsLogger(None) - - try - // TODO: Should unify starting and restarting - log (Started, key) - Interlocked.Increment &restarted |> ignore - System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" - let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger - - try - let! result = computation |> Async.AwaitNodeCode - post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) - return () - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger - with - | TaskCancelled _ -> - Interlocked.Increment &cancel_exception_subsequent |> ignore - post (key, CancelRequest) - () - | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) - } - ), - cts.Token) - |> ignore - - | CancelRequest, Some(Running(tcs, cts, _c, _, _)) -> - - Interlocked.Increment &cancel_subsequent_processed |> ignore - - decrRequestCount key - - if requestCounts[key] < 1 then - cancelRegistration key - cts.Cancel() - tcs.TrySetCanceled() |> ignore - // Remember the job in case it completes after cancellation - cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) - requestCounts.Remove key |> ignore - log (Canceled, key) - Interlocked.Increment &canceled |> ignore - use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] - () - - // Probably in some cases cancellation can be fired off even after we just unregistered it - | CancelRequest, None - | CancelRequest, Some(Completed _) - | CancelRequest, Some(Job.Canceled _) - | CancelRequest, Some(Job.Failed _) - | OriginatorCanceled, None - | OriginatorCanceled, Some(Completed _) - | OriginatorCanceled, Some(Job.Canceled _) - | OriginatorCanceled, Some(Job.Failed _) -> () - - | JobFailed(ex, diags), Some(Running(tcs, _cts, _c, _ts, loggers)) -> - cancelRegistration key - cache.Set(key.Key, key.Version, key.Label, Job.Failed(DateTime.Now, ex)) - requestCounts.Remove key |> ignore - log (Failed, key) - Interlocked.Increment &failed |> ignore - failures.Add(key.Label, ex) - - for logger in loggers do - diags |> replayDiagnostics logger - - tcs.TrySetException ex |> ignore - - | JobCompleted(result, diags), Some(Running(tcs, _cts, _c, started, loggers)) -> - cancelRegistration key - cache.Set(key.Key, key.Version, key.Label, (Completed(result, diags))) - requestCounts.Remove key |> ignore - log (Finished, key) - Interlocked.Increment &completed |> ignore - let duration = float (DateTime.Now - started).Milliseconds - - avgDurationMs <- - if completed < 2 then - duration - else - avgDurationMs + (duration - avgDurationMs) / float completed - - for logger in loggers do - diags |> replayDiagnostics logger - - if tcs.TrySetResult result = false then - internalError key.Label "Invalid state: Completed job already completed" - - // Sometimes job can be canceled but it still manages to complete (or fail) - | JobFailed _, Some(Job.Canceled _) - | JobCompleted _, Some(Job.Canceled _) -> () - - // Job can't be evicted from cache while it's running because then subsequent requesters would be waiting forever - | JobFailed _, None -> internalError key.Label "Invalid state: Running job missing in cache (failed)" - - | JobCompleted _, None -> internalError key.Label "Invalid state: Running job missing in cache (completed)" - - | JobFailed(ex, _diags), Some(Completed(_job, _diags2)) -> - internalError key.Label $"Invalid state: Failed Completed job \n%A{ex}" - - | JobCompleted(_result, _diags), Some(Completed(_job, _diags2)) -> - internalError key.Label "Invalid state: Double-Completed job" - - | JobFailed(ex, _diags), Some(Job.Failed(_, ex2)) -> - internalError key.Label $"Invalid state: Double-Failed job \n%A{ex} \n%A{ex2}" - - | JobCompleted(_result, _diags), Some(Job.Failed(_, ex2)) -> - internalError key.Label $"Invalid state: Completed Failed job \n%A{ex2}" - }) + Interlocked.Increment &cancel_original_processed |> ignore + + decrRequestCount key + + if requestCounts[key] < 1 then + cancelRegistration key + cts.Cancel() + tcs.TrySetCanceled() |> ignore + // Remember the job in case it completes after cancellation + cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) + requestCounts.Remove key |> ignore + log (Canceled, key) + Interlocked.Increment &canceled |> ignore + use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] + () + + else + // We need to restart the computation + restart key computation cts.Token None |> ignore + + | CancelRequest, Some(Running(tcs, cts, _c, _, _)) -> + + Interlocked.Increment &cancel_subsequent_processed |> ignore + + decrRequestCount key + + if requestCounts[key] < 1 then + cancelRegistration key + cts.Cancel() + tcs.TrySetCanceled() |> ignore + // Remember the job in case it completes after cancellation + cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) + requestCounts.Remove key |> ignore + log (Canceled, key) + Interlocked.Increment &canceled |> ignore + use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] + () + + // Probably in some cases cancellation can be fired off even after we just unregistered it + | CancelRequest, None + | CancelRequest, Some(Completed _) + | CancelRequest, Some(Job.Canceled _) + | CancelRequest, Some(Job.Failed _) + | OriginatorCanceled, None + | OriginatorCanceled, Some(Completed _) + | OriginatorCanceled, Some(Job.Canceled _) + | OriginatorCanceled, Some(Job.Failed _) -> () + + | JobFailed(ex, diags), Some(Running(tcs, _cts, _c, _ts, loggers)) -> + cancelRegistration key + cache.Set(key.Key, key.Version, key.Label, Job.Failed(DateTime.Now, ex)) + requestCounts.Remove key |> ignore + log (Failed, key) + Interlocked.Increment &failed |> ignore + failures.Add(key.Label, ex) + + for logger in loggers do + diags |> replayDiagnostics logger + + tcs.TrySetException ex |> ignore + + | JobCompleted(result, diags), Some(Running(tcs, _cts, _c, started, loggers)) -> + cancelRegistration key + cache.Set(key.Key, key.Version, key.Label, (Completed(result, diags))) + requestCounts.Remove key |> ignore + log (Finished, key) + Interlocked.Increment &completed |> ignore + let duration = float (DateTime.Now - started).Milliseconds + + avgDurationMs <- + if completed < 2 then + duration + else + avgDurationMs + (duration - avgDurationMs) / float completed + + for logger in loggers do + diags |> replayDiagnostics logger + + if tcs.TrySetResult result = false then + internalError key.Label "Invalid state: Completed job already completed" + + // Sometimes job can be canceled but it still manages to complete (or fail) + | JobFailed _, Some(Job.Canceled _) + | JobCompleted _, Some(Job.Canceled _) -> () + + // Job can't be evicted from cache while it's running because then subsequent requesters would be waiting forever + | JobFailed _, None -> internalError key.Label "Invalid state: Running job missing in cache (failed)" + + | JobCompleted _, None -> internalError key.Label "Invalid state: Running job missing in cache (completed)" + + | JobFailed(ex, _diags), Some(Completed(_job, _diags2)) -> + internalError key.Label $"Invalid state: Failed Completed job \n%A{ex}" + + | JobCompleted(_result, _diags), Some(Completed(_job, _diags2)) -> internalError key.Label "Invalid state: Double-Completed job" + + | JobFailed(ex, _diags), Some(Job.Failed(_, ex2)) -> + internalError key.Label $"Invalid state: Double-Failed job \n%A{ex} \n%A{ex2}" + + | JobCompleted(_result, _diags), Some(Job.Failed(_, ex2)) -> + internalError key.Label $"Invalid state: Completed Failed job \n%A{ex2}" } - let rec post msg = - Task.Run(fun () -> processStateUpdate post msg :> Task) |> ignore + let processRequest (key: KeyData<_, _>, msg) diagnosticLogger = + task { + use! _gate = lock.Gate() + + let cached, otherVersions = cache.GetAll(key.Key, key.Version) + + match msg, cached with + | GetOrCompute _, Some(Completed(result, diags)) -> + Interlocked.Increment &hits |> ignore + diags |> replayDiagnostics diagnosticLogger + return Existing(Task.FromResult result) + | GetOrCompute(_, ct), Some(Running(tcs, _, _, _, loggers)) -> + Interlocked.Increment &hits |> ignore + incrRequestCount key + + ct.Register(fun _ -> + let _name = name + Interlocked.Increment &cancel_ct_registration_subsequent |> ignore + post (key, CancelRequest)) + |> saveRegistration key + + loggers.Add diagnosticLogger + + return Existing tcs.Task + + | GetOrCompute(computation, ct), None + | GetOrCompute(computation, ct), Some(Job.Canceled _) + | GetOrCompute(computation, ct), Some(Job.Failed _) -> + Interlocked.Increment &started |> ignore + incrRequestCount key + + ct.Register(fun _ -> + let _name = name + Interlocked.Increment &cancel_ct_registration_original |> ignore + post (key, OriginatorCanceled)) + |> saveRegistration key + + let cts = new CancellationTokenSource() + + cache.Set(key.Key, key.Version, key.Label, (Running(TaskCompletionSource(), cts, computation, DateTime.Now, ResizeArray()))) + + otherVersions + |> Seq.choose (function + | v, Running(_tcs, cts, _, _, _) -> Some(v, cts) + | _ -> None) + |> Seq.iter (fun (_v, cts) -> + use _ = Activity.start $"{name}: Duplicate running job" [| "key", key.Label |] + //System.Diagnostics.Trace.TraceWarning($"{name} Duplicate {key.Label}") + if cancelDuplicateRunningJobs then + //System.Diagnostics.Trace.TraceWarning("Canceling") + cts.Cancel()) + + return New cts.Token + } member this.Get'(key, computation) = @@ -482,48 +509,13 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let callerDiagnosticLogger = DiagnosticsThreadStatics.DiagnosticsLogger match! - processRequest post (key, GetOrCompute(computation, ct)) callerDiagnosticLogger + processRequest (key, GetOrCompute(computation, ct)) callerDiagnosticLogger |> NodeCode.AwaitTask with | New internalCt -> - - let linkedCtSource = CancellationTokenSource.CreateLinkedTokenSource(ct, internalCt) - let cachingLogger = new CachingDiagnosticsLogger(Some callerDiagnosticLogger) - - try - return! - Async.StartAsTask( - async { - // TODO: Should unify starting and restarting - let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger - - log (Started, key) - - try - let! result = computation |> Async.AwaitNodeCode - post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) - return result - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger - }, - cancellationToken = linkedCtSource.Token - ) - |> NodeCode.AwaitTask - with - | TaskCancelled ex -> - // TODO: do we need to do anything else here? Presumably it should be done by the registration on - // the cancellation token or before we triggered our own cancellation - - // Let's send this again just in case. It seems sometimes it's not triggered from the registration? - - Interlocked.Increment &cancel_exception_original |> ignore - - post (key, (OriginatorCanceled)) - return raise ex - | ex -> - post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) - return raise ex + return! + start key computation internalCt (Some callerDiagnosticLogger) + |> NodeCode.AwaitTask | Existing job -> return! job |> NodeCode.AwaitTask From 1a66d72c6fddd8127bfcc22ec2c483534a544af6 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 17 Jan 2024 11:59:42 +0100 Subject: [PATCH 12/35] fantomas --- src/Compiler/Facilities/AsyncMemoize.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 732915d7774..09aee4c8d7d 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -514,7 +514,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T with | New internalCt -> return! - start key computation internalCt (Some callerDiagnosticLogger) + start key computation internalCt (Some callerDiagnosticLogger) |> NodeCode.AwaitTask | Existing job -> return! job |> NodeCode.AwaitTask From a8201eb4ee8b40f4bf26b4a74db9536803bbbff9 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 17 Jan 2024 13:04:31 +0100 Subject: [PATCH 13/35] draft release notes --- docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index d9acfde71ca..67dbf777b5d 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -11,4 +11,5 @@ * `implicitCtorSynPats` in `SynTypeDefnSimpleRepr.General` is now `SynPat option` instead of `SynSimplePats option`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425)) * `SyntaxVisitorBase<'T>.VisitSimplePats` now takes `SynPat` instead of `SynSimplePat list`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425)) -* Reduce allocations in compiler checking via `ValueOption` usage ([PR #16323](https://github.com/dotnet/fsharp/pull/16323)) \ No newline at end of file +* Reduce allocations in compiler checking via `ValueOption` usage ([PR #16323](https://github.com/dotnet/fsharp/pull/16323)) +* Reduce indentation in `AsyncMemoize`. ([PR #16540](https://github.com/dotnet/fsharp/pull/16540)) \ No newline at end of file From 8d00ee6e537c25f95d839539bc2e1196ffedcd74 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 13:37:44 +0100 Subject: [PATCH 14/35] use thread-safe collections when collecting events from AsyncMemoize --- .../CompilerService/AsyncMemoize.fs | 52 +------------------ .../FSharpChecker/TransparentCompiler.fs | 36 ++++++------- 2 files changed, 20 insertions(+), 68 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 92dda5bd044..fcd10321ad8 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -75,10 +75,10 @@ let ``We can cancel a job`` () = failwith "Should be canceled before it gets here" } - let eventLog = ResizeArray() + let eventLog = ConcurrentQueue() let memoize = AsyncMemoize() memoize.OnEvent(fun (e, (_label, k, _version)) -> - eventLog.Add (e, k) + eventLog.Enqueue (e, k) if e = Canceled then jobCanceled.Set() |> ignore ) @@ -157,54 +157,6 @@ let ``Job is restarted if first requestor cancels`` () = Assert.Equal<_ list>(expected, orderedLog) } -// [] - if we decide to enable that -let ``Job keeps running if the first requestor cancels`` () = - task { - let jobStarted = new ManualResetEvent(false) - - let computation key = node { - jobStarted.Set() |> ignore - - for _ in 1 .. 5 do - do! Async.Sleep 100 |> NodeCode.AwaitAsync - - return key * 2 - } - - let eventLog = ConcurrentBag() - let memoize = AsyncMemoize() - memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Add (DateTime.Now.Ticks, (e, k))) - - use cts1 = new CancellationTokenSource() - use cts2 = new CancellationTokenSource() - use cts3 = new CancellationTokenSource() - - let key = 1 - - let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) - jobStarted.WaitOne() |> ignore - - let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) - let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) - - jobStarted.WaitOne() |> ignore - - cts1.Cancel() - - do! Task.Delay 100 - cts3.Cancel() - - let! result = _task2 - Assert.Equal(2, result) - - Assert.Equal(TaskStatus.Canceled, _task1.Status) - - let orderedLog = eventLog |> Seq.sortBy fst |> Seq.map snd |> Seq.toList - let expected = [ Started, key; Finished, key ] - - Assert.Equal<_ list>(expected, orderedLog) - } - [] let ``Job is restarted if first requestor cancels but keeps running if second requestor cancels`` () = task { diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs index a6b7f6fcc41..57a9e266fe8 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs @@ -219,13 +219,13 @@ let ``Changes in a referenced project`` () = [] let ``File is not checked twice`` () = - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() testWorkflow() { withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "First" updatePublicSurface checkFile "Third" expectOk @@ -242,13 +242,13 @@ let ``File is not checked twice`` () = [] let ``If a file is checked as a dependency it's not re-checked later`` () = - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() testWorkflow() { withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "First" updatePublicSurface checkFile "Last" expectOk @@ -272,13 +272,13 @@ let ``We don't check files that are not depended on`` () = sourceFile "Third" ["First"], sourceFile "Last" ["Third"]) - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "First" updatePublicSurface checkFile "Last" expectOk @@ -302,8 +302,8 @@ let ``Files that are not depended on don't invalidate cache`` () = sourceFile "Third" ["First"], sourceFile "Last" ["Third"]) - let cacheTcIntermediateEvents = ResizeArray() - let cacheGraphConstructionEvents = ResizeArray() + let cacheTcIntermediateEvents = ConcurrentQueue() + let cacheGraphConstructionEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { updateFile "First" updatePublicSurface @@ -311,8 +311,8 @@ let ``Files that are not depended on don't invalidate cache`` () = withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheTcIntermediateEvents.Add - checker.Caches.DependencyGraph.OnEvent cacheGraphConstructionEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheTcIntermediateEvents.Enqueue + checker.Caches.DependencyGraph.OnEvent cacheGraphConstructionEvents.Enqueue }) updateFile "Second" updatePublicSurface @@ -344,8 +344,8 @@ let ``Files that are not depended on don't invalidate cache part 2`` () = sourceFile "D" ["B"; "C"], sourceFile "E" ["C"]) - let cacheTcIntermediateEvents = ResizeArray() - let cacheGraphConstructionEvents = ResizeArray() + let cacheTcIntermediateEvents = ConcurrentQueue() + let cacheGraphConstructionEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { updateFile "A" updatePublicSurface @@ -353,8 +353,8 @@ let ``Files that are not depended on don't invalidate cache part 2`` () = withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheTcIntermediateEvents.Add - checker.Caches.DependencyGraph.OnEvent cacheGraphConstructionEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheTcIntermediateEvents.Enqueue + checker.Caches.DependencyGraph.OnEvent cacheGraphConstructionEvents.Enqueue }) updateFile "B" updatePublicSurface checkFile "E" expectOk @@ -382,7 +382,7 @@ let ``Changing impl files doesn't invalidate cache when they have signatures`` ( { sourceFile "B" ["A"] with SignatureFile = AutoGenerated }, { sourceFile "C" ["B"] with SignatureFile = AutoGenerated }) - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { updateFile "A" updatePublicSurface @@ -390,7 +390,7 @@ let ``Changing impl files doesn't invalidate cache when they have signatures`` ( withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "A" updateInternal checkFile "C" expectOk @@ -412,14 +412,14 @@ let ``Changing impl file doesn't invalidate an in-memory referenced project`` () SyntheticProject.Create("project", sourceFile "B" ["A"] ) with DependsOn = [library] } - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { checkFile "B" expectOk withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "A" updateInternal checkFile "B" expectOk From 22cc08061e54f9ce0a6d6a18a4b76878f7958fc4 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 13:37:44 +0100 Subject: [PATCH 15/35] use thread-safe collections when collecting events from AsyncMemoize --- .../CompilerService/AsyncMemoize.fs | 52 +------------------ .../FSharpChecker/TransparentCompiler.fs | 36 ++++++------- 2 files changed, 20 insertions(+), 68 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 92dda5bd044..fcd10321ad8 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -75,10 +75,10 @@ let ``We can cancel a job`` () = failwith "Should be canceled before it gets here" } - let eventLog = ResizeArray() + let eventLog = ConcurrentQueue() let memoize = AsyncMemoize() memoize.OnEvent(fun (e, (_label, k, _version)) -> - eventLog.Add (e, k) + eventLog.Enqueue (e, k) if e = Canceled then jobCanceled.Set() |> ignore ) @@ -157,54 +157,6 @@ let ``Job is restarted if first requestor cancels`` () = Assert.Equal<_ list>(expected, orderedLog) } -// [] - if we decide to enable that -let ``Job keeps running if the first requestor cancels`` () = - task { - let jobStarted = new ManualResetEvent(false) - - let computation key = node { - jobStarted.Set() |> ignore - - for _ in 1 .. 5 do - do! Async.Sleep 100 |> NodeCode.AwaitAsync - - return key * 2 - } - - let eventLog = ConcurrentBag() - let memoize = AsyncMemoize() - memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Add (DateTime.Now.Ticks, (e, k))) - - use cts1 = new CancellationTokenSource() - use cts2 = new CancellationTokenSource() - use cts3 = new CancellationTokenSource() - - let key = 1 - - let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) - jobStarted.WaitOne() |> ignore - - let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) - let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) - - jobStarted.WaitOne() |> ignore - - cts1.Cancel() - - do! Task.Delay 100 - cts3.Cancel() - - let! result = _task2 - Assert.Equal(2, result) - - Assert.Equal(TaskStatus.Canceled, _task1.Status) - - let orderedLog = eventLog |> Seq.sortBy fst |> Seq.map snd |> Seq.toList - let expected = [ Started, key; Finished, key ] - - Assert.Equal<_ list>(expected, orderedLog) - } - [] let ``Job is restarted if first requestor cancels but keeps running if second requestor cancels`` () = task { diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs index a6b7f6fcc41..57a9e266fe8 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs @@ -219,13 +219,13 @@ let ``Changes in a referenced project`` () = [] let ``File is not checked twice`` () = - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() testWorkflow() { withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "First" updatePublicSurface checkFile "Third" expectOk @@ -242,13 +242,13 @@ let ``File is not checked twice`` () = [] let ``If a file is checked as a dependency it's not re-checked later`` () = - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() testWorkflow() { withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "First" updatePublicSurface checkFile "Last" expectOk @@ -272,13 +272,13 @@ let ``We don't check files that are not depended on`` () = sourceFile "Third" ["First"], sourceFile "Last" ["Third"]) - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "First" updatePublicSurface checkFile "Last" expectOk @@ -302,8 +302,8 @@ let ``Files that are not depended on don't invalidate cache`` () = sourceFile "Third" ["First"], sourceFile "Last" ["Third"]) - let cacheTcIntermediateEvents = ResizeArray() - let cacheGraphConstructionEvents = ResizeArray() + let cacheTcIntermediateEvents = ConcurrentQueue() + let cacheGraphConstructionEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { updateFile "First" updatePublicSurface @@ -311,8 +311,8 @@ let ``Files that are not depended on don't invalidate cache`` () = withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheTcIntermediateEvents.Add - checker.Caches.DependencyGraph.OnEvent cacheGraphConstructionEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheTcIntermediateEvents.Enqueue + checker.Caches.DependencyGraph.OnEvent cacheGraphConstructionEvents.Enqueue }) updateFile "Second" updatePublicSurface @@ -344,8 +344,8 @@ let ``Files that are not depended on don't invalidate cache part 2`` () = sourceFile "D" ["B"; "C"], sourceFile "E" ["C"]) - let cacheTcIntermediateEvents = ResizeArray() - let cacheGraphConstructionEvents = ResizeArray() + let cacheTcIntermediateEvents = ConcurrentQueue() + let cacheGraphConstructionEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { updateFile "A" updatePublicSurface @@ -353,8 +353,8 @@ let ``Files that are not depended on don't invalidate cache part 2`` () = withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheTcIntermediateEvents.Add - checker.Caches.DependencyGraph.OnEvent cacheGraphConstructionEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheTcIntermediateEvents.Enqueue + checker.Caches.DependencyGraph.OnEvent cacheGraphConstructionEvents.Enqueue }) updateFile "B" updatePublicSurface checkFile "E" expectOk @@ -382,7 +382,7 @@ let ``Changing impl files doesn't invalidate cache when they have signatures`` ( { sourceFile "B" ["A"] with SignatureFile = AutoGenerated }, { sourceFile "C" ["B"] with SignatureFile = AutoGenerated }) - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { updateFile "A" updatePublicSurface @@ -390,7 +390,7 @@ let ``Changing impl files doesn't invalidate cache when they have signatures`` ( withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "A" updateInternal checkFile "C" expectOk @@ -412,14 +412,14 @@ let ``Changing impl file doesn't invalidate an in-memory referenced project`` () SyntheticProject.Create("project", sourceFile "B" ["A"] ) with DependsOn = [library] } - let cacheEvents = ResizeArray() + let cacheEvents = ConcurrentQueue() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { checkFile "B" expectOk withChecker (fun checker -> async { do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Add + checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue }) updateFile "A" updateInternal checkFile "B" expectOk From da52d7c1e387be3519e0fa755ad44159e98254ca Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 14:23:18 +0100 Subject: [PATCH 16/35] try adding Cancellable.UsingToken in ProjectWorkflowBuilder --- tests/FSharp.Test.Utilities/ProjectGeneration.fs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/FSharp.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index 54c00ebe544..e50f4e093c7 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -34,6 +34,7 @@ open Xunit open OpenTelemetry open OpenTelemetry.Resources open OpenTelemetry.Trace +open FSharp.Compiler #nowarn "57" // Experimental feature use @@ -845,6 +846,7 @@ type ProjectWorkflowBuilder let mutable latestProject = initialProject let mutable activity = None let mutable tracerProvider = None + let mutable cancellableToken = None let getSource f = f |> getSourceText latestProject :> ISourceText |> Some |> async.Return @@ -893,6 +895,8 @@ type ProjectWorkflowBuilder member this.Checker = checker member this.Yield _ = async { + let! ct = Async.CancellationToken + cancellableToken <- Some (Cancellable.UsingToken ct) let! ctx = getInitialContext() tracerProvider <- Sdk.CreateTracerProviderBuilder() @@ -921,6 +925,7 @@ type ProjectWorkflowBuilder tracerProvider |> Option.iter (fun x -> x.ForceFlush() |> ignore x.Dispose()) + cancellableToken |> Option.iter (fun x -> x.Dispose()) member this.Run(workflow: Async) = if autoStart then From e0a81c6d212f2baff68c16f0cc44a9fd04525d1d Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 15:15:27 +0100 Subject: [PATCH 17/35] this might be better --- .../FSharp.Test.Utilities/ProjectGeneration.fs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/tests/FSharp.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index e50f4e093c7..9f4d0be9403 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -846,7 +846,6 @@ type ProjectWorkflowBuilder let mutable latestProject = initialProject let mutable activity = None let mutable tracerProvider = None - let mutable cancellableToken = None let getSource f = f |> getSourceText latestProject :> ISourceText |> Some |> async.Return @@ -895,8 +894,6 @@ type ProjectWorkflowBuilder member this.Checker = checker member this.Yield _ = async { - let! ct = Async.CancellationToken - cancellableToken <- Some (Cancellable.UsingToken ct) let! ctx = getInitialContext() tracerProvider <- Sdk.CreateTracerProviderBuilder() @@ -925,13 +922,17 @@ type ProjectWorkflowBuilder tracerProvider |> Option.iter (fun x -> x.ForceFlush() |> ignore x.Dispose()) - cancellableToken |> Option.iter (fun x -> x.Dispose()) member this.Run(workflow: Async) = - if autoStart then - this.Execute(workflow) |> async.Return - else - workflow + async { + let! ct = Async.CancellationToken + use _ = Cancellable.UsingToken ct + + if autoStart then + return this.Execute(workflow) + else + return! workflow + } [] member this.WithProject(workflow: Async, f) = From de74123c991c9ae35918710cc14dba0665691876 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 16:18:23 +0100 Subject: [PATCH 18/35] sprinkle in some more Cancellable.UsingToken --- src/Compiler/Service/TransparentCompiler.fs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index fe82627483f..4dedf758c5e 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1790,8 +1790,10 @@ type internal TransparentCompiler member _.FindReferencesInFile(fileName: string, projectSnapshot: ProjectSnapshot, symbol: FSharpSymbol, userOpName: string) = ignore userOpName - node { + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + match! ComputeItemKeyStore(fileName, projectSnapshot) with | None -> return Seq.empty | Some itemKeyStore -> return itemKeyStore.FindAll symbol.Item From 27b492ae9286b67aa0aa78236baeb018a9c71e73 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 17:13:28 +0100 Subject: [PATCH 19/35] revert --- tests/FSharp.Test.Utilities/ProjectGeneration.fs | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/tests/FSharp.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index 9f4d0be9403..54c00ebe544 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -34,7 +34,6 @@ open Xunit open OpenTelemetry open OpenTelemetry.Resources open OpenTelemetry.Trace -open FSharp.Compiler #nowarn "57" // Experimental feature use @@ -924,15 +923,10 @@ type ProjectWorkflowBuilder x.Dispose()) member this.Run(workflow: Async) = - async { - let! ct = Async.CancellationToken - use _ = Cancellable.UsingToken ct - - if autoStart then - return this.Execute(workflow) - else - return! workflow - } + if autoStart then + this.Execute(workflow) |> async.Return + else + workflow [] member this.WithProject(workflow: Async, f) = From ff134767ab6f03914e52afb3d609fe57a254b98d Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Wed, 17 Jan 2024 17:21:20 +0100 Subject: [PATCH 20/35] f --- src/Compiler/Service/TransparentCompiler.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 4dedf758c5e..d5436cc31fe 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1790,6 +1790,7 @@ type internal TransparentCompiler member _.FindReferencesInFile(fileName: string, projectSnapshot: ProjectSnapshot, symbol: FSharpSymbol, userOpName: string) = ignore userOpName + node { let! ct = NodeCode.CancellationToken use _ = Cancellable.UsingToken(ct) From 78048ce549f245bb2da80b61f717e209e1b82c33 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 17 Jan 2024 23:11:11 +0100 Subject: [PATCH 21/35] only posted cancel requests --- src/Compiler/Facilities/AsyncMemoize.fs | 54 ++++++++----------------- 1 file changed, 17 insertions(+), 37 deletions(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 09aee4c8d7d..c50bd13b5f2 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -173,10 +173,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let mutable cleared = 0 let mutable cancel_ct_registration_original = 0 - let mutable cancel_exception_original = 0 let mutable cancel_original_processed = 0 let mutable cancel_ct_registration_subsequent = 0 - let mutable cancel_exception_subsequent = 0 let mutable cancel_subsequent_processed = 0 let failures = ResizeArray() @@ -276,14 +274,6 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger with | TaskCancelled ex -> - // TODO: do we need to do anything else here? Presumably it should be done by the registration on - // the cancellation token or before we triggered our own cancellation - - // Let's send this again just in case. It seems sometimes it's not triggered from the registration? - - Interlocked.Increment &cancel_exception_original |> ignore - - post (key, (OriginatorCanceled)) return raise ex | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) @@ -308,13 +298,22 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T finally DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger with - | TaskCancelled _ -> - Interlocked.Increment &cancel_exception_subsequent |> ignore - post (key, CancelRequest) - () + | TaskCancelled _ -> () | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) } + and cancel key (cts: CancellationTokenSource) (tcs: TaskCompletionSource<_>) = + cancelRegistration key + cts.Cancel() + tcs.TrySetCanceled() |> ignore + // Remember the job in case it completes after cancellation + cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) + requestCounts.Remove key |> ignore + log (Canceled, key) + Interlocked.Increment &canceled |> ignore + use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] + () + and processStateUpdate (key: KeyData<_, _>, action: StateUpdate<_>) = task { do! Task.Yield() @@ -331,17 +330,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T decrRequestCount key if requestCounts[key] < 1 then - cancelRegistration key - cts.Cancel() - tcs.TrySetCanceled() |> ignore - // Remember the job in case it completes after cancellation - cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) - requestCounts.Remove key |> ignore - log (Canceled, key) - Interlocked.Increment &canceled |> ignore - use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] - () - + cancel key cts tcs else // We need to restart the computation restart key computation cts.Token None |> ignore @@ -353,16 +342,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T decrRequestCount key if requestCounts[key] < 1 then - cancelRegistration key - cts.Cancel() - tcs.TrySetCanceled() |> ignore - // Remember the job in case it completes after cancellation - cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) - requestCounts.Remove key |> ignore - log (Canceled, key) - Interlocked.Increment &canceled |> ignore - use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] - () + cancel key cts tcs // Probably in some cases cancellation can be fired off even after we just unregistered it | CancelRequest, None @@ -517,8 +497,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T start key computation internalCt (Some callerDiagnosticLogger) |> NodeCode.AwaitTask - | Existing job -> return! job |> NodeCode.AwaitTask - + | Existing job -> + return! job |> NodeCode.AwaitTask } member _.Clear() = cache.Clear() From 1cc0ffd4af4e7ca96977df718c3c0c97abaab2bc Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 17 Jan 2024 23:18:43 +0100 Subject: [PATCH 22/35] format --- src/Compiler/Facilities/AsyncMemoize.fs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index c50bd13b5f2..f1575ce9eac 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -273,8 +273,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T finally DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger with - | TaskCancelled ex -> - return raise ex + | TaskCancelled ex -> return raise ex | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) return raise ex @@ -497,8 +496,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T start key computation internalCt (Some callerDiagnosticLogger) |> NodeCode.AwaitTask - | Existing job -> - return! job |> NodeCode.AwaitTask + | Existing job -> return! job |> NodeCode.AwaitTask } member _.Clear() = cache.Clear() From 4319d1d67279e558bbbdb206ce11e8e71beee1a3 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 18 Jan 2024 01:35:23 +0100 Subject: [PATCH 23/35] don't restart while there are requestors --- src/Compiler/Facilities/AsyncMemoize.fs | 55 +++++-------------- .../CompilerService/AsyncMemoize.fs | 26 ++------- 2 files changed, 19 insertions(+), 62 deletions(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index f1575ce9eac..c3b8a259c97 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -256,10 +256,9 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let rec post msg = processStateUpdate msg |> ignore - // TODO: Should unify starting and restarting - and start key computation ct loggerOpt = + and start key computation ct logger = task { - let cachingLogger = new CachingDiagnosticsLogger(loggerOpt) + let cachingLogger = new CachingDiagnosticsLogger(Some logger) try let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger @@ -279,28 +278,6 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T return raise ex } - and restart key computation ct loggerOpt = - task { - let cachingLogger = new CachingDiagnosticsLogger(loggerOpt) - - try - let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger - log (Started, key) - - Interlocked.Increment &restarted |> ignore - System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" - - try - let! result = compute computation ct - post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger - with - | TaskCancelled _ -> () - | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) - } - and cancel key (cts: CancellationTokenSource) (tcs: TaskCompletionSource<_>) = cancelRegistration key cts.Cancel() @@ -322,7 +299,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T match action, cached with - | OriginatorCanceled, Some(Running(tcs, cts, computation, _, _)) -> + | OriginatorCanceled, Some(Running(tcs, cts, _, _, _)) -> Interlocked.Increment &cancel_original_processed |> ignore @@ -330,9 +307,6 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T if requestCounts[key] < 1 then cancel key cts tcs - else - // We need to restart the computation - restart key computation cts.Token None |> ignore | CancelRequest, Some(Running(tcs, cts, _c, _, _)) -> @@ -482,21 +456,18 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T Version = key.GetVersion() } - node { - let! ct = NodeCode.CancellationToken - - let callerDiagnosticLogger = DiagnosticsThreadStatics.DiagnosticsLogger + let getOrCompute ct = + task { + let callerDiagnosticLogger = DiagnosticsThreadStatics.DiagnosticsLogger - match! - processRequest (key, GetOrCompute(computation, ct)) callerDiagnosticLogger - |> NodeCode.AwaitTask - with - | New internalCt -> - return! - start key computation internalCt (Some callerDiagnosticLogger) - |> NodeCode.AwaitTask + match! processRequest (key, GetOrCompute(computation, ct)) callerDiagnosticLogger with + | New internalCt -> return! start key computation internalCt callerDiagnosticLogger + | Existing job -> return! job + } - | Existing job -> return! job |> NodeCode.AwaitTask + node { + let! ct = NodeCode.CancellationToken + return! getOrCompute ct |> Async.AwaitTask |> NodeCode.AwaitAsync } member _.Clear() = cache.Clear() diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index fcd10321ad8..9bda7f32ac0 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -84,8 +84,7 @@ let ``We can cancel a job`` () = ) use cts1 = new CancellationTokenSource() - use cts2 = new CancellationTokenSource() - use cts3 = new CancellationTokenSource() + let key = 1 @@ -94,23 +93,15 @@ let ``We can cancel a job`` () = waitFor jobStarted jobStarted.Reset() |> ignore - let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation ignore), ct = cts2.Token) - let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation ignore), ct = cts3.Token) - cts1.Cancel() - cts2.Cancel() - - waitFor jobStarted - - cts3.Cancel() waitFor jobCanceled - Assert.Equal<(JobEvent * int) array>([| Started, key; Started, key; Canceled, key |], eventLog |> Seq.toArray ) + Assert.Equal<(JobEvent * int) array>([| Started, key; Canceled, key |], eventLog |> Seq.toArray ) } [] -let ``Job is restarted if first requestor cancels`` () = +let ``Job is not cancelled if just one requestor cancels`` () = task { let jobStarted = new ManualResetEvent(false) @@ -141,9 +132,6 @@ let ``Job is restarted if first requestor cancels`` () = let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) cts1.Cancel() - - waitFor jobStarted - cts3.Cancel() jobCanComplete.Set() |> ignore @@ -152,13 +140,13 @@ let ``Job is restarted if first requestor cancels`` () = Assert.Equal(2, result) let orderedLog = eventLog |> Seq.rev |> Seq.toList - let expected = [ Started, key; Started, key; Finished, key ] + let expected = [ Started, key; Finished, key ] Assert.Equal<_ list>(expected, orderedLog) } [] -let ``Job is restarted if first requestor cancels but keeps running if second requestor cancels`` () = +let ``Job is not cancelled while there are requestors`` () = task { let jobStarted = new ManualResetEvent(false) @@ -190,8 +178,6 @@ let ``Job is restarted if first requestor cancels but keeps running if second re cts1.Cancel() - jobStarted.WaitOne() |> ignore - cts2.Cancel() jobCanComplete.Set() |> ignore @@ -200,7 +186,7 @@ let ``Job is restarted if first requestor cancels but keeps running if second re Assert.Equal(2, result) let orderedLog = eventLog |> Seq.rev |> Seq.toList - let expected = [ Started, key; Started, key; Finished, key ] + let expected = [ Started, key; Finished, key ] Assert.Equal<_ list>(expected, orderedLog) } From 9090f3f5c174c5de2d91d7b5f2aa5a35434bcc3f Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 18 Jan 2024 02:28:52 +0100 Subject: [PATCH 24/35] add test --- .../CompilerService/AsyncMemoize.fs | 45 +++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 9bda7f32ac0..f479d7d63b9 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -191,6 +191,51 @@ let ``Job is not cancelled while there are requestors`` () = Assert.Equal<_ list>(expected, orderedLog) } +[] +let ``Job is cancelled when all requestors cancel`` () = + task { + let jobStarted = new ManualResetEvent(false) + + let jobCanComplete = new ManualResetEvent(false) + + let computation key = node { + jobStarted.Set() |> ignore + waitFor jobCanComplete + return key * 2 + } + + let eventLog = ConcurrentStack() + let memoize = AsyncMemoize() + memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Push (e, k)) + + use cts1 = new CancellationTokenSource() + use cts2 = new CancellationTokenSource() + use cts3 = new CancellationTokenSource() + + let key = 1 + + let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) + + jobStarted.WaitOne() |> ignore + jobStarted.Reset() |> ignore + + let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) + let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) + + cts1.Cancel() + cts2.Cancel() + cts3.Cancel() + + jobCanComplete.Set() |> ignore + + let! _ = Assert.ThrowsAsync(fun () -> _task3) + + let orderedLog = eventLog |> Seq.rev |> Seq.toList + let expected = [ Started, key; Canceled, key ] + + Assert.Equal<_ list>(expected, orderedLog) + } + type ExpectedException() = inherit Exception() From 607d1e1322f070e239ff51e8357716ee54002b94 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 18 Jan 2024 09:43:54 +0100 Subject: [PATCH 25/35] wip rel notes --- docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index d9acfde71ca..67dbf777b5d 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -11,4 +11,5 @@ * `implicitCtorSynPats` in `SynTypeDefnSimpleRepr.General` is now `SynPat option` instead of `SynSimplePats option`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425)) * `SyntaxVisitorBase<'T>.VisitSimplePats` now takes `SynPat` instead of `SynSimplePat list`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425)) -* Reduce allocations in compiler checking via `ValueOption` usage ([PR #16323](https://github.com/dotnet/fsharp/pull/16323)) \ No newline at end of file +* Reduce allocations in compiler checking via `ValueOption` usage ([PR #16323](https://github.com/dotnet/fsharp/pull/16323)) +* Reduce indentation in `AsyncMemoize`. ([PR #16540](https://github.com/dotnet/fsharp/pull/16540)) \ No newline at end of file From 6132eae280762049a1065bf0a87b43786d1b45dd Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 18 Jan 2024 11:59:01 +0100 Subject: [PATCH 26/35] try to fix test --- tests/FSharp.Test.Utilities/Utilities.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Test.Utilities/Utilities.fs b/tests/FSharp.Test.Utilities/Utilities.fs index d6dc8d2e6b4..6a785033d6d 100644 --- a/tests/FSharp.Test.Utilities/Utilities.fs +++ b/tests/FSharp.Test.Utilities/Utilities.fs @@ -108,8 +108,8 @@ module Utilities = let outputLines = StringBuilder() let errorLines = StringBuilder() - do redirector.OutputProduced.Add (fun line -> outputLines.AppendLine line |>ignore) - do redirector.ErrorProduced.Add(fun line -> errorLines.AppendLine line |>ignore) + do redirector.OutputProduced.Add (fun line -> lock outputLines <| fun () -> outputLines.AppendLine line |> ignore) + do redirector.ErrorProduced.Add(fun line -> lock errorLines <| fun () -> errorLines.AppendLine line |> ignore) member _.Output () = outputLines.ToString() From cb660ce8a346bdfe1dd7cf3782750a873f641f9c Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 18 Jan 2024 12:01:13 +0100 Subject: [PATCH 27/35] rel notes --- docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index 67dbf777b5d..57138870d87 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -12,4 +12,4 @@ * `implicitCtorSynPats` in `SynTypeDefnSimpleRepr.General` is now `SynPat option` instead of `SynSimplePats option`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425)) * `SyntaxVisitorBase<'T>.VisitSimplePats` now takes `SynPat` instead of `SynSimplePat list`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425)) * Reduce allocations in compiler checking via `ValueOption` usage ([PR #16323](https://github.com/dotnet/fsharp/pull/16323)) -* Reduce indentation in `AsyncMemoize`. ([PR #16540](https://github.com/dotnet/fsharp/pull/16540)) \ No newline at end of file +* Rework cancellation in `AsyncMemoize`. ([PR #16547](https://github.com/dotnet/fsharp/pull/16547)) \ No newline at end of file From e23f203526dfaa3d4801eebb60a28bb937887566 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 18 Jan 2024 13:10:07 +0100 Subject: [PATCH 28/35] fix flaky test --- .../CompilerService/AsyncMemoize.fs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index f479d7d63b9..bfef7d681ea 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -198,6 +198,8 @@ let ``Job is cancelled when all requestors cancel`` () = let jobCanComplete = new ManualResetEvent(false) + use eventTriggered = new ManualResetEventSlim(false) + let computation key = node { jobStarted.Set() |> ignore waitFor jobCanComplete @@ -206,7 +208,9 @@ let ``Job is cancelled when all requestors cancel`` () = let eventLog = ConcurrentStack() let memoize = AsyncMemoize() - memoize.OnEvent(fun (e, (_label, k, _version)) -> eventLog.Push (e, k)) + memoize.OnEvent(fun (e, (_label, k, _version)) -> + eventLog.Push (e, k) + eventTriggered.Set() |> ignore) use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -219,6 +223,10 @@ let ``Job is cancelled when all requestors cancel`` () = jobStarted.WaitOne() |> ignore jobStarted.Reset() |> ignore + eventTriggered.Wait() + eventTriggered.Reset() + + let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) @@ -228,7 +236,9 @@ let ``Job is cancelled when all requestors cancel`` () = jobCanComplete.Set() |> ignore - let! _ = Assert.ThrowsAsync(fun () -> _task3) + // Wait for the event to be logged. + eventTriggered.Wait(timeout) |> ignore + eventTriggered.Reset() let orderedLog = eventLog |> Seq.rev |> Seq.toList let expected = [ Started, key; Canceled, key ] From e4e5b59bed0ef747d845a2dc705e834a456bb741 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 18 Jan 2024 17:34:52 +0100 Subject: [PATCH 29/35] fix test again --- .../CompilerService/AsyncMemoize.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index bfef7d681ea..4f3b14be0f8 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -234,12 +234,12 @@ let ``Job is cancelled when all requestors cancel`` () = cts2.Cancel() cts3.Cancel() - jobCanComplete.Set() |> ignore - // Wait for the event to be logged. eventTriggered.Wait(timeout) |> ignore eventTriggered.Reset() + jobCanComplete.Set() |> ignore + let orderedLog = eventLog |> Seq.rev |> Seq.toList let expected = [ Started, key; Canceled, key ] From b152e6dbae584977ad0c20ad288e5b72119568e5 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Fri, 19 Jan 2024 21:37:53 +0100 Subject: [PATCH 30/35] stringbuilder is not threadsafe --- tests/FSharp.Test.Utilities/Utilities.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/FSharp.Test.Utilities/Utilities.fs b/tests/FSharp.Test.Utilities/Utilities.fs index d6dc8d2e6b4..d434d837485 100644 --- a/tests/FSharp.Test.Utilities/Utilities.fs +++ b/tests/FSharp.Test.Utilities/Utilities.fs @@ -108,12 +108,12 @@ module Utilities = let outputLines = StringBuilder() let errorLines = StringBuilder() - do redirector.OutputProduced.Add (fun line -> outputLines.AppendLine line |>ignore) - do redirector.ErrorProduced.Add(fun line -> errorLines.AppendLine line |>ignore) + do redirector.OutputProduced.Add (fun line -> lock outputLines <| fun () -> outputLines.AppendLine line |>ignore) + do redirector.ErrorProduced.Add(fun line -> lock errorLines <| fun () -> errorLines.AppendLine line |>ignore) - member _.Output () = outputLines.ToString() + member _.Output () = lock outputLines outputLines.ToString - member _.ErrorOutput () = errorLines.ToString() + member _.ErrorOutput () = lock errorLines errorLines.ToString interface IDisposable with member _.Dispose() = (redirector :> IDisposable).Dispose() From c623ea8125654e7d5d7b56488046bd9bf317819a Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Sat, 20 Jan 2024 14:52:46 +0100 Subject: [PATCH 31/35] try to fix test --- .../CompilerService/AsyncMemoize.fs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 4f3b14be0f8..b461c92cbc8 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -198,7 +198,7 @@ let ``Job is cancelled when all requestors cancel`` () = let jobCanComplete = new ManualResetEvent(false) - use eventTriggered = new ManualResetEventSlim(false) + use eventTriggered = new ManualResetEvent(false) let computation key = node { jobStarted.Set() |> ignore @@ -223,20 +223,24 @@ let ``Job is cancelled when all requestors cancel`` () = jobStarted.WaitOne() |> ignore jobStarted.Reset() |> ignore - eventTriggered.Wait() - eventTriggered.Reset() + eventTriggered.WaitOne() |> ignore + eventTriggered.Reset() |> ignore let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) + // Give the other tasks a chance to actually start. + do! Task.Yield() + let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) + do! Task.Yield() cts1.Cancel() cts2.Cancel() cts3.Cancel() // Wait for the event to be logged. - eventTriggered.Wait(timeout) |> ignore - eventTriggered.Reset() + eventTriggered.WaitOne(timeout) |> ignore + eventTriggered.Reset() |> ignore jobCanComplete.Set() |> ignore From 73643fda0fd63110b81788268674949df392e11f Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Sat, 20 Jan 2024 18:33:38 +0100 Subject: [PATCH 32/35] just in case --- src/Compiler/Facilities/BuildGraph.fs | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 8927862c23c..9edce0a9094 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -151,24 +151,7 @@ type NodeCode private () = NodeCode.RunImmediate(computation, CancellationToken.None) static member StartAsTask_ForTesting(computation: NodeCode<'T>, ?ct: CancellationToken) = - let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger - let phase = DiagnosticsThreadStatics.BuildPhase - let ct2 = Cancellable.Token - - try - let work = - async { - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger - DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct2 - return! computation |> Async.AwaitNodeCode - } - - Async.StartAsTask(work, cancellationToken = defaultArg ct CancellationToken.None) - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger - DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct2 + Async.StartAsTask(computation |> Async.AwaitNodeCode, ?cancellationToken = ct) static member CancellationToken = cancellationToken From 9fef34b673346ff6a465414d0a7491da83cae8c0 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Mon, 22 Jan 2024 14:03:50 +0100 Subject: [PATCH 33/35] revert --- src/Compiler/Facilities/BuildGraph.fs | 5 ---- src/Compiler/Interactive/fsi.fs | 3 -- src/Compiler/Service/BackgroundCompiler.fs | 31 -------------------- src/Compiler/Service/FSharpCheckerResults.fs | 2 -- src/Compiler/Service/TransparentCompiler.fs | 26 ---------------- src/Compiler/Service/service.fs | 4 --- 6 files changed, 71 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 9edce0a9094..062626a32cd 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -17,14 +17,12 @@ let wrapThreadStaticInfo computation = async { let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase - let ct = Cancellable.Token try return! computation finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct } type Async<'T> with @@ -127,7 +125,6 @@ type NodeCode private () = static member RunImmediate(computation: NodeCode<'T>, ct: CancellationToken) = let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase - let ct2 = Cancellable.Token try try @@ -135,7 +132,6 @@ type NodeCode private () = async { DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct2 return! computation |> Async.AwaitNodeCode } @@ -143,7 +139,6 @@ type NodeCode private () = finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase - Cancellable.Token <- ct2 with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> raise (ex.InnerExceptions[0]) diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index ca0e2335064..e5ff5b6c754 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4089,7 +4089,6 @@ type FsiInteractionProcessor ?cancellationToken: CancellationToken ) = let cancellationToken = defaultArg cancellationToken CancellationToken.None - use _ = Cancellable.UsingToken(cancellationToken) if tokenizer.LexBuffer.IsPastEndOfStream then let stepStatus = @@ -4218,7 +4217,6 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, diagnosticsLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None - use _ = Cancellable.UsingToken(cancellationToken) use _ = UseBuildPhase BuildPhase.Interactive use _ = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID @@ -4895,7 +4893,6 @@ type FsiEvaluationSession SpawnInteractiveServer(fsi, fsiOptions, fsiConsoleOutput) use _ = UseBuildPhase BuildPhase.Interactive - use _ = Cancellable.UsingToken(CancellationToken.None) if fsiOptions.Interact then // page in the type check env diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index 514bb8e45c5..a85a86f209f 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -574,9 +574,6 @@ type internal BackgroundCompiler Activity.Tags.cache, cache.ToString() |] - let! ct = Async.CancellationToken - use _ = Cancellable.UsingToken(ct) - if cache then let hash = sourceText.GetHashCode() |> int64 @@ -629,9 +626,6 @@ type internal BackgroundCompiler "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -783,9 +777,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! cachedResults = node { let! builderOpt, creationDiags = getAnyBuilder (options, userOpName) @@ -846,9 +837,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -897,9 +885,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -969,9 +954,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -991,9 +973,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -1134,9 +1113,6 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) - let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -1185,8 +1161,6 @@ type internal BackgroundCompiler /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) member private _.ParseAndCheckProjectImpl(options, userOpName) = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -1327,9 +1301,6 @@ type internal BackgroundCompiler // Do we assume .NET Framework references for scripts? let assumeDotNetFramework = defaultArg assumeDotNetFramework true - let! ct = Cancellable.token () - use _ = Cancellable.UsingToken(ct) - let extraFlags = if previewEnabled then [| "--langversion:preview" |] @@ -1452,8 +1423,6 @@ type internal BackgroundCompiler |] async { - let! ct = Async.CancellationToken - use _ = Cancellable.UsingToken(ct) let! ct = Async.CancellationToken // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 48b9875c9f0..cdefe667394 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -3585,8 +3585,6 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal member _.ParseAndCheckInteraction(sourceText: ISourceText, ?userOpName: string) = cancellable { - let! ct = Cancellable.token () - use _ = Cancellable.UsingToken(ct) let userOpName = defaultArg userOpName "Unknown" let fileName = Path.Combine(tcConfig.implicitIncludeDir, "stdin.fsx") diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index d5436cc31fe..ab64f2f7418 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1762,8 +1762,6 @@ type internal TransparentCompiler node { //use _ = // Activity.start "ParseFile" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) // TODO: might need to deal with exceptions here: let tcConfigB, sourceFileNames, _ = ComputeTcConfigBuilder projectSnapshot @@ -1792,8 +1790,6 @@ type internal TransparentCompiler ignore userOpName node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) match! ComputeItemKeyStore(fileName, projectSnapshot) with | None -> return Seq.empty @@ -1821,8 +1817,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText) @@ -1845,8 +1839,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText) @@ -1900,8 +1892,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode> = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) ignore canInvalidateProject let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync @@ -1917,8 +1907,6 @@ type internal TransparentCompiler member this.GetAssemblyData(options: FSharpProjectOptions, fileName, userOpName: string) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync return! this.GetAssemblyData(snapshot.ProjectSnapshot, fileName, userOpName) @@ -1939,8 +1927,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync @@ -1956,8 +1942,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync return! this.ParseFile(fileName, snapshot.ProjectSnapshot, userOpName) @@ -1972,8 +1956,6 @@ type internal TransparentCompiler ) : NodeCode<(FSharpParseFileResults * FSharpCheckFileResults) option> = node { ignore builder - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, 1, sourceText) @@ -2026,8 +2008,6 @@ type internal TransparentCompiler ) : NodeCode = node { ignore userOpName - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync return! ComputeSemanticClassification(fileName, snapshot.ProjectSnapshot) @@ -2051,8 +2031,6 @@ type internal TransparentCompiler userOpName: string ) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText) @@ -2066,8 +2044,6 @@ type internal TransparentCompiler member this.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) ignore userOpName let! snapshot = FSharpProjectSnapshot.FromOptions options |> NodeCode.AwaitAsync @@ -2076,8 +2052,6 @@ type internal TransparentCompiler member this.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : NodeCode = node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) ignore userOpName return! ComputeParseAndCheckProject projectSnapshot.ProjectSnapshot diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index b79254d7935..5ac50733448 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -348,8 +348,6 @@ type FSharpChecker use _ = Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] async { - let! ct = Async.CancellationToken - use _ = Cancellable.UsingToken(ct) let ctok = CompilationThreadToken() return CompileHelpers.compileFromArgs (ctok, argv, legacyReferenceResolver, None, None) @@ -485,8 +483,6 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" node { - let! ct = NodeCode.CancellationToken - use _ = Cancellable.UsingToken(ct) if fastCheck <> Some true || not captureIdentifiersWhenParsing then return! backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) From 41a849ce1d9b78240b1fa6c6f7f2440de2bfa8e8 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Mon, 22 Jan 2024 14:26:04 +0100 Subject: [PATCH 34/35] tests --- .../CompilerService/AsyncMemoize.fs | 70 ++++++++++--------- 1 file changed, 36 insertions(+), 34 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index b461c92cbc8..3cd2cff7ad1 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -14,10 +14,14 @@ open FSharp.Compiler.BuildGraph let timeout = TimeSpan.FromSeconds 10 -let waitFor (mre: ManualResetEvent) = - if not <| mre.WaitOne timeout then - failwith "waitFor timed out" +let waitForA (mre: EventWaitHandle) = + async { + let! waitResult = Async.AwaitWaitHandle(mre, int timeout.TotalMilliseconds) + if not waitResult then failwith "waitFor timed out" + } +let waitFor h = h |> waitForA |> Async.StartImmediateAsTask +let internal waitForN h = h |> waitForA |> NodeCode.AwaitAsync let rec internal spinFor (duration: TimeSpan) = node { @@ -90,12 +94,12 @@ let ``We can cancel a job`` () = let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation jobStarted.Set), ct = cts1.Token) - waitFor jobStarted + do! waitFor jobStarted jobStarted.Reset() |> ignore cts1.Cancel() - waitFor jobCanceled + do! waitFor jobCanceled Assert.Equal<(JobEvent * int) array>([| Started, key; Canceled, key |], eventLog |> Seq.toArray ) } @@ -103,13 +107,13 @@ let ``We can cancel a job`` () = [] let ``Job is not cancelled if just one requestor cancels`` () = task { - let jobStarted = new ManualResetEvent(false) + let jobStarted = new AutoResetEvent(false) let jobCanComplete = new ManualResetEvent(false) let computation key = node { jobStarted.Set() |> ignore - waitFor jobCanComplete + do! waitForN jobCanComplete return key * 2 } @@ -125,8 +129,7 @@ let ``Job is not cancelled if just one requestor cancels`` () = let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) - waitFor jobStarted - jobStarted.Reset() |> ignore + do! waitFor jobStarted let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) @@ -148,14 +151,11 @@ let ``Job is not cancelled if just one requestor cancels`` () = [] let ``Job is not cancelled while there are requestors`` () = task { - let jobStarted = new ManualResetEvent(false) - let jobCanComplete = new ManualResetEvent(false) let computation key = node { - jobStarted.Set() |> ignore - waitFor jobCanComplete - return key * 2 + do! waitForN jobCanComplete + return key * 2 } let eventLog = ConcurrentStack() @@ -168,11 +168,7 @@ let ``Job is not cancelled while there are requestors`` () = let key = 1 - let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) - - jobStarted.WaitOne() |> ignore - jobStarted.Reset() |> ignore - + let _task1 = NodeCode.StartAsTask_ForTesting(memoize.Get'(key, computation key), ct = cts1.Token) let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) @@ -198,11 +194,11 @@ let ``Job is cancelled when all requestors cancel`` () = let jobCanComplete = new ManualResetEvent(false) - use eventTriggered = new ManualResetEvent(false) + use eventTriggered = new AutoResetEvent(false) let computation key = node { jobStarted.Set() |> ignore - waitFor jobCanComplete + do! waitForN jobCanComplete return key * 2 } @@ -220,12 +216,9 @@ let ``Job is cancelled when all requestors cancel`` () = let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) - jobStarted.WaitOne() |> ignore - jobStarted.Reset() |> ignore - - eventTriggered.WaitOne() |> ignore - eventTriggered.Reset() |> ignore + do! waitFor jobStarted + do! waitFor eventTriggered let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) // Give the other tasks a chance to actually start. @@ -239,8 +232,7 @@ let ``Job is cancelled when all requestors cancel`` () = cts3.Cancel() // Wait for the event to be logged. - eventTriggered.WaitOne(timeout) |> ignore - eventTriggered.Reset() |> ignore + do! waitFor eventTriggered jobCanComplete.Set() |> ignore @@ -381,14 +373,21 @@ let ``Cancel running jobs with the same key`` cancelDuplicate expectFinished = task { let cache = AsyncMemoize(cancelDuplicateRunningJobs=cancelDuplicate) + use jobCompleted = new AutoResetEvent(false) + use jobStarted = new AutoResetEvent(false) + let mutable started = 0 let mutable finished = 0 let work () = node { - Interlocked.Increment &started |> ignore - for _ in 1..10 do - do! Async.Sleep 10 |> NodeCode.AwaitAsync - Interlocked.Increment &finished |> ignore + jobStarted.Set() |> ignore + try + Interlocked.Increment &started |> ignore + for _ in 1..10 do + do! Async.Sleep 10 |> NodeCode.AwaitAsync + Interlocked.Increment &finished |> ignore + finally + jobCompleted.Set() |> ignore } let key1 = @@ -399,7 +398,7 @@ let ``Cancel running jobs with the same key`` cancelDuplicate expectFinished = cache.Get(key1, work()) |> Async.AwaitNodeCode |> Async.Start - do! Task.Delay 50 + do! waitFor jobStarted let key2 = { new ICacheKey<_, _> with @@ -409,7 +408,10 @@ let ``Cancel running jobs with the same key`` cancelDuplicate expectFinished = cache.Get(key2, work()) |> Async.AwaitNodeCode |> Async.Start - do! Task.Delay 500 + do! waitFor jobStarted + + do! waitFor jobCompleted + do! waitFor jobCompleted Assert.Equal((2, expectFinished), (started, finished)) } From 010a41880a0320692fd4b27147158d492ccdfe1f Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Mon, 22 Jan 2024 17:41:38 +0100 Subject: [PATCH 35/35] try fix test --- .../CompilerService/AsyncMemoize.fs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 3cd2cff7ad1..a2dcb8ff2dc 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -107,8 +107,7 @@ let ``We can cancel a job`` () = [] let ``Job is not cancelled if just one requestor cancels`` () = task { - let jobStarted = new AutoResetEvent(false) - + let jobStarted = new ManualResetEvent(false) let jobCanComplete = new ManualResetEvent(false) let computation key = node { @@ -128,12 +127,11 @@ let ``Job is not cancelled if just one requestor cancels`` () = let key = 1 let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) - - do! waitFor jobStarted - let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) + do! waitFor jobStarted + cts1.Cancel() cts3.Cancel()