Skip to content

Commit

Permalink
Use RunImmediate for better debug stacks (#11788)
Browse files Browse the repository at this point in the history 
* Use RunImmediate for better debug stacks

* fix build

Co-authored-by: Don Syme <[email protected]>
  • Loading branch information
@dsyme
dsyme and Don Syme authored Jul 6, 2021
1 parent dfeb8a9 commit d48369f
Show file tree
Hide file tree
Showing 30 changed files with 394 additions and 311 deletions.
14 changes: 14 additions & 0 deletions src/fsharp/absil/illib.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ open System.Collections.Concurrent
open System.Diagnostics
open System.IO
open System.Threading
open System.Threading.Tasks
open System.Runtime.CompilerServices

[<AutoOpen>]
Expand Down Expand Up @@ -86,6 +87,19 @@ module internal PervasiveAutoOpens =

let notFound() = raise (KeyNotFoundException())

type Async with
static member RunImmediate (computation: Async<'T>, ?cancellationToken ) =
let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken
let ts = TaskCompletionSource<'T>()
let task = ts.Task
Async.StartWithContinuations(
computation,
(fun k -> ts.SetResult k),
(fun exn -> ts.SetException exn),
(fun _ -> ts.SetCanceled()),
cancellationToken)
task.Result

[<Struct>]
/// An efficient lazy for inline storage in a class type. Results in fewer thunks.
type InlineDelayInit<'T when 'T : not struct> =
Expand Down
4 changes: 4 additions & 0 deletions src/fsharp/absil/illib.fsi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,10 @@ module internal PervasiveAutoOpens =

member inline EndsWithOrdinal: value:string -> bool

type Async with
/// Runs the computation synchronously, always starting on the current thread.
static member RunImmediate: computation: Async<'T> * ?cancellationToken: CancellationToken -> 'T

val foldOn: p:('a -> 'b) -> f:('c -> 'b -> 'd) -> z:'c -> x:'a -> 'd

val notFound: unit -> 'a
Expand Down
57 changes: 23 additions & 34 deletions src/fsharp/service/service.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -955,31 +955,25 @@ type BackgroundCompiler(

member _.ProjectChecked = projectChecked.Publish

member _.ClearCachesAsync (_userOpName) =
async {
return
lock gate (fun () ->
parseCacheLock.AcquireLock (fun ltok ->
checkFileInProjectCache.Clear(ltok)
parseFileCache.Clear(ltok))
incrementalBuildersCache.Clear(AnyCallerThread)
frameworkTcImportsCache.Clear()
scriptClosureCache.Clear (AnyCallerThread)
)
}
member _.ClearCaches() =
lock gate (fun () ->
parseCacheLock.AcquireLock (fun ltok ->
checkFileInProjectCache.Clear(ltok)
parseFileCache.Clear(ltok))
incrementalBuildersCache.Clear(AnyCallerThread)
frameworkTcImportsCache.Clear()
scriptClosureCache.Clear (AnyCallerThread)
)

member _.DownsizeCaches(_userOpName) =
async {
return
lock gate (fun () ->
parseCacheLock.AcquireLock (fun ltok ->
checkFileInProjectCache.Resize(ltok, newKeepStrongly=1)
parseFileCache.Resize(ltok, newKeepStrongly=1))
incrementalBuildersCache.Resize(AnyCallerThread, newKeepStrongly=1, newKeepMax=1)
frameworkTcImportsCache.Downsize()
scriptClosureCache.Resize(AnyCallerThread,newKeepStrongly=1, newKeepMax=1)
)
}
member _.DownsizeCaches() =
lock gate (fun () ->
parseCacheLock.AcquireLock (fun ltok ->
checkFileInProjectCache.Resize(ltok, newKeepStrongly=1)
parseFileCache.Resize(ltok, newKeepStrongly=1))
incrementalBuildersCache.Resize(AnyCallerThread, newKeepStrongly=1, newKeepMax=1)
frameworkTcImportsCache.Downsize()
scriptClosureCache.Resize(AnyCallerThread,newKeepStrongly=1, newKeepMax=1)
)

member _.FrameworkImportsCache = frameworkTcImportsCache

Expand Down Expand Up @@ -1195,29 +1189,24 @@ type FSharpChecker(legacyReferenceResolver,
member ic.InvalidateAll() =
ic.ClearCaches()

member _.ClearCachesAsync(?userOpName: string) =
member ic.ClearCaches() =
let utok = AnyCallerThread
let userOpName = defaultArg userOpName "Unknown"
braceMatchCache.Clear(utok)
backgroundCompiler.ClearCachesAsync(userOpName)

member ic.ClearCaches(?userOpName) =
ic.ClearCachesAsync(?userOpName=userOpName) |> Async.Start // this cache clearance is not synchronous, it will happen when the background op gets run
backgroundCompiler.ClearCaches()

member _.CheckMaxMemoryReached() =
if not maxMemoryReached && System.GC.GetTotalMemory(false) > int64 maxMB * 1024L * 1024L then
Trace.TraceWarning("!!!!!!!! MAX MEMORY REACHED, DOWNSIZING F# COMPILER CACHES !!!!!!!!!!!!!!!")
// If the maxMB limit is reached, drastic action is taken
// - reduce strong cache sizes to a minimum
let userOpName = "MaxMemoryReached"
maxMemoryReached <- true
braceMatchCache.Resize(AnyCallerThread, newKeepStrongly=10)
backgroundCompiler.DownsizeCaches(userOpName) |> Async.RunSynchronously
backgroundCompiler.DownsizeCaches()
maxMemEvent.Trigger( () )

// This is for unit testing only
member ic.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() =
ic.ClearCachesAsync() |> Async.RunSynchronously
ic.ClearCaches()
System.GC.Collect()
System.GC.WaitForPendingFinalizers()
FxResolver.ClearStaticCaches()
Expand All @@ -1229,7 +1218,7 @@ type FSharpChecker(legacyReferenceResolver,
backgroundCompiler.InvalidateConfiguration(options, userOpName)

/// Clear the internal cache of the given projects.
member _.ClearCache(options: FSharpProjectOptions seq, ?userOpName: string) =
member _.ClearCache(options: seq<FSharpProjectOptions>, ?userOpName: string) =
let userOpName = defaultArg userOpName "Unknown"
backgroundCompiler.ClearCache(options, userOpName)

Expand Down
6 changes: 3 additions & 3 deletions tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,7 +71,7 @@ module BuildGraphTests =

let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode))

Async.RunSynchronously(work)
Async.RunImmediate(work)
|> ignore

Assert.shouldBe 1 computationCount
Expand All @@ -84,7 +84,7 @@ module BuildGraphTests =

let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode))

let result = Async.RunSynchronously(work)
let result = Async.RunImmediate(work)

Assert.shouldNotBeEmpty result
Assert.shouldBe requests result.Length
Expand Down Expand Up @@ -116,7 +116,7 @@ module BuildGraphTests =

Assert.shouldBeTrue weak.IsAlive

Async.RunSynchronously(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode)))
Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode)))
|> ignore

GC.Collect(2, GCCollectionMode.Forced, true)
Expand Down
26 changes: 13 additions & 13 deletions tests/FSharp.Test.Utilities/CompilerAssert.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -132,7 +132,7 @@ type CompilerAssert private () =
options
|> Array.append defaultProjectOptions.OtherOptions
|> Array.append [| "fsc.dll"; inputFilePath; "-o:" + outputFilePath; (if isExe then "--target:exe" else "--target:library"); "--nowin32manifest" |]
let errors, _ = checker.Compile args |> Async.RunSynchronously
let errors, _ = checker.Compile args |> Async.RunImmediate
errors, outputFilePath

static let compileAux isExe options source f : unit =
Expand Down Expand Up @@ -397,7 +397,7 @@ type CompilerAssert private () =

let parseResults =
checker.ParseFile("test.fs", SourceText.ofString source, parseOptions)
|> Async.RunSynchronously
|> Async.RunImmediate

Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)

Expand All @@ -410,7 +410,7 @@ type CompilerAssert private () =

let compileErrors, statusCode =
checker.Compile([parseResults.ParseTree], "test", outputFilePath, dependencies, executable = isExe, noframework = true)
|> Async.RunSynchronously
|> Async.RunImmediate

Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors)
Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode)
Expand All @@ -421,7 +421,7 @@ type CompilerAssert private () =
let parseOptions = { FSharpParsingOptions.Default with SourceFiles = [|"test.fs"|] }
let parseResults =
checker.ParseFile("test.fs", SourceText.ofString source, parseOptions)
|> Async.RunSynchronously
|> Async.RunImmediate

Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)

Expand All @@ -434,15 +434,15 @@ type CompilerAssert private () =

let compileErrors, statusCode, assembly =
checker.CompileToDynamicAssembly([parseResults.ParseTree], assemblyName, dependencies, None, noframework = true)
|> Async.RunSynchronously
|> Async.RunImmediate

Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors)
Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode)
Assert.IsTrue(assembly.IsSome, "no assembly returned")
Option.get assembly

static member Pass (source: string) =
let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously
let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunImmediate

Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)

Expand All @@ -455,7 +455,7 @@ type CompilerAssert private () =
static member PassWithOptions options (source: string) =
let options = { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}

let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, options) |> Async.RunSynchronously
let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, options) |> Async.RunImmediate

Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)

Expand All @@ -473,7 +473,7 @@ type CompilerAssert private () =
0,
SourceText.ofString (File.ReadAllText absoluteSourceFile),
{ defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions; SourceFiles = [|sourceFile|] })
|> Async.RunSynchronously
|> Async.RunImmediate

Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)

Expand Down Expand Up @@ -503,7 +503,7 @@ type CompilerAssert private () =
0,
SourceText.ofString source,
{ defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions; SourceFiles = [|name|] })
|> Async.RunSynchronously
|> Async.RunImmediate

if parseResults.Diagnostics.Length > 0 then
parseResults.Diagnostics
Expand All @@ -523,7 +523,7 @@ type CompilerAssert private () =
0,
SourceText.ofString source,
{ defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions})
|> Async.RunSynchronously
|> Async.RunImmediate

if parseResults.Diagnostics.Length > 0 then
parseResults.Diagnostics
Expand All @@ -543,7 +543,7 @@ type CompilerAssert private () =
0,
SourceText.ofString source,
{ defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions})
|> Async.RunSynchronously
|> Async.RunImmediate

match fileAnswer with
| FSharpCheckFileAnswer.Aborted _ -> Assert.Fail("Type Checker Aborted"); failwith "Type Checker Aborted"
Expand All @@ -565,7 +565,7 @@ type CompilerAssert private () =
0,
SourceText.ofString source,
{ defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions})
|> Async.RunSynchronously
|> Async.RunImmediate

if parseResults.Diagnostics.Length > 0 then
parseResults.Diagnostics
Expand Down Expand Up @@ -669,7 +669,7 @@ type CompilerAssert private () =
static member Parse (source: string) =
let sourceFileName = "test.fs"
let parsingOptions = { FSharpParsingOptions.Default with SourceFiles = [| sourceFileName |] }
checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunSynchronously
checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunImmediate

static member ParseWithErrors (source: string) expectedParseErrors =
let parseResults = CompilerAssert.Parse source
Expand Down
16 changes: 15 additions & 1 deletion tests/FSharp.Test.Utilities/Utilities.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,10 @@ open System
open System.IO
open System.Reflection
open System.Collections.Immutable
open System.Diagnostics
open System.Threading.Tasks
open Microsoft.CodeAnalysis
open Microsoft.CodeAnalysis.CSharp
open System.Diagnostics
open FSharp.Test.Utilities
open TestFramework
open NUnit.Framework
Expand All @@ -17,6 +18,19 @@ open NUnit.Framework

module Utilities =

type Async with
static member RunImmediate (computation: Async<'T>, ?cancellationToken ) =
let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken
let ts = TaskCompletionSource<'T>()
let task = ts.Task
Async.StartWithContinuations(
computation,
(fun k -> ts.SetResult k),
(fun exn -> ts.SetException exn),
(fun _ -> ts.SetCanceled()),
cancellationToken)
task.Result

[<RequireQualifiedAccess>]
type TargetFramework =
| NetStandard20
Expand Down
Loading

0 comments on commit d48369f

Please sign in to comment.