From 899ad91506abfcf37dbd50eb553c81730af60286 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 23 Nov 2016 13:08:21 +0000 Subject: [PATCH 1/3] Fix 1805,1807 --- src/fsharp/CompileOps.fs | 1 + src/fsharp/FSStrings.resx | 3 +++ .../src/FSharp.Editor/BreakpointResolutionService.fs | 9 ++++----- vsintegration/src/FSharp.Editor/CompletionProvider.fs | 9 ++++++--- vsintegration/src/FSharp.Editor/GoToDefinitionService.fs | 7 ++++--- .../src/FSharp.Editor/LanguageDebugInfoService.fs | 4 +++- 6 files changed, 21 insertions(+), 12 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index b1dcc1c77a5..91dc03a6482 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -992,6 +992,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = | Parser.TOKEN_KEYWORD_STRING -> getErrorString("Parser.TOKEN.KEYWORD_STRING") | Parser.TOKEN_EOF -> getErrorString("Parser.TOKEN.EOF") | Parser.TOKEN_CONST -> getErrorString("Parser.TOKEN.CONST") + | Parser.TOKEN_FIXED -> getErrorString("Parser.TOKEN.FIXED") | unknown -> System.Diagnostics.Debug.Assert(false,"unknown token tag") let result = sprintf "%+A" unknown diff --git a/src/fsharp/FSStrings.resx b/src/fsharp/FSStrings.resx index 04bce992367..9dd1eef5577 100644 --- a/src/fsharp/FSStrings.resx +++ b/src/fsharp/FSStrings.resx @@ -447,6 +447,9 @@ keyword 'internal' + + keyword 'fixed' + keyword 'constraint' diff --git a/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs b/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs index c50ae6cba46..3aa4f907744 100644 --- a/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs +++ b/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs @@ -33,12 +33,11 @@ type internal FSharpBreakpointResolutionService() = static member GetBreakpointLocation(sourceText: SourceText, fileName: string, textSpan: TextSpan, options: FSharpProjectOptions) = async { let! parseResults = FSharpChecker.Instance.ParseFileInProject(fileName, sourceText.ToString(), options) - let textLine = sourceText.Lines.GetLineFromPosition(textSpan.Start) + let textLinePos = sourceText.Lines.GetLinePosition(textSpan.Start) + let textLineColumn = textLinePos.Character + let fcsTextLineNumber = textLinePos.Line + 1 // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based - let textLineNumber = textLine.LineNumber + 1 // Roslyn line numbers are zero-based - let textColumnNumber = textSpan.Start - textLine.Start - - return parseResults.ValidateBreakpointLocation(mkPos textLineNumber textColumnNumber) + return parseResults.ValidateBreakpointLocation(mkPos fcsTextLineNumber textLineColumn) } interface IBreakpointResolutionService with diff --git a/vsintegration/src/FSharp.Editor/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/CompletionProvider.fs index 3c5c8878b34..1c7aec7f95a 100644 --- a/vsintegration/src/FSharp.Editor/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/CompletionProvider.fs @@ -80,9 +80,12 @@ type internal FSharpCompletionProvider(workspace: Workspace, serviceProvider: SV | FSharpCheckFileAnswer.Succeeded(results) -> results let textLine = sourceText.Lines.GetLineFromPosition(caretPosition) - let textLineNumber = textLine.LineNumber + 1 // Roslyn line numbers are zero-based - let qualifyingNames, partialName = QuickParse.GetPartialLongNameEx(textLine.ToString(), caretPosition - textLine.Start - 1) - let! declarations = checkFileResults.GetDeclarationListInfo(Some(parseResults), textLineNumber, caretPosition, textLine.ToString(), qualifyingNames, partialName) + let textLinePos = sourceText.Lines.GetLinePosition(caretPosition) + let fcsTextLineNumber = textLinePos.Line + 1 // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based + let textLineColumn = textLinePos.Character + + let qualifyingNames, partialName = QuickParse.GetPartialLongNameEx(textLine.ToString(), textLineColumn - 1) + let! declarations = checkFileResults.GetDeclarationListInfo(Some(parseResults), fcsTextLineNumber, textLineColumn, textLine.ToString(), qualifyingNames, partialName) let results = List() diff --git a/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs b/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs index 62bc7bfd47b..a839f6c9721 100644 --- a/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs +++ b/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs @@ -54,8 +54,9 @@ type internal FSharpGoToDefinitionService [] ([> = async { let textLine = sourceText.Lines.GetLineFromPosition(position) - let textLineNumber = textLine.LineNumber + 1 // Roslyn line numbers are zero-based - let textLineColumn = sourceText.Lines.GetLinePosition(position).Character + let textLinePos = sourceText.Lines.GetLinePosition(position) + let fcsTextLineNumber = textLinePos.Line + 1 // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based + let textLineColumn = textLinePos.Character let classifiedSpanOption = FSharpColorizationService.GetColorizationData(sourceText, textLine.Span, Some(filePath), defines, cancellationToken) |> Seq.tryFind(fun classifiedSpan -> classifiedSpan.TextSpan.Contains(position)) @@ -67,7 +68,7 @@ type internal FSharpGoToDefinitionService [] ([ failwith "Compilation isn't complete yet" | FSharpCheckFileAnswer.Succeeded(results) -> results - let! declarations = checkFileResults.GetDeclarationLocationAlternate (textLineNumber, islandColumn, textLine.ToString(), qualifiers, false) + let! declarations = checkFileResults.GetDeclarationLocationAlternate (fcsTextLineNumber, islandColumn, textLine.ToString(), qualifiers, false) return match declarations with | FSharpFindDeclResult.DeclFound(range) -> Some(range) diff --git a/vsintegration/src/FSharp.Editor/LanguageDebugInfoService.fs b/vsintegration/src/FSharp.Editor/LanguageDebugInfoService.fs index bba0ecf6b5a..928988ce323 100644 --- a/vsintegration/src/FSharp.Editor/LanguageDebugInfoService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageDebugInfoService.fs @@ -46,7 +46,9 @@ type internal FSharpLanguageDebugInfoService() = | ClassificationTypeNames.Identifier -> let textLine = sourceText.Lines.GetLineFromPosition(position) - match QuickParse.GetCompleteIdentifierIsland false (textLine.ToString()) (position - textLine.Start) with + let textLinePos = sourceText.Lines.GetLinePosition(position) + let textLineColumn = textLinePos.Character + match QuickParse.GetCompleteIdentifierIsland false (textLine.ToString()) textLineColumn with | None -> None | Some(island, islandEnd, _) -> let islandDocumentStart = textLine.Start + islandEnd - island.Length From 2b5824ea6c91300406ee3e5041414a29d1b21508 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 23 Nov 2016 13:23:20 +0000 Subject: [PATCH 2/3] fix assert in goto-definition --- .../src/FSharp.Editor/BraceMatchingService.fs | 2 +- .../BreakpointResolutionService.fs | 2 +- .../src/FSharp.Editor/ColorizationService.fs | 4 ++-- .../src/FSharp.Editor/CompletionProvider.fs | 4 ++-- .../DocumentDiagnosticAnalyzer.fs | 4 ++-- .../src/FSharp.Editor/GoToDefinitionService.fs | 18 ++++++++++-------- .../src/FSharp.Editor/LanguageService.fs | 5 ++++- .../FSharp.Editor/ProjectDiagnosticAnalyzer.fs | 2 +- 8 files changed, 23 insertions(+), 18 deletions(-) diff --git a/vsintegration/src/FSharp.Editor/BraceMatchingService.fs b/vsintegration/src/FSharp.Editor/BraceMatchingService.fs index c76b640b565..10b4d0c0cc8 100644 --- a/vsintegration/src/FSharp.Editor/BraceMatchingService.fs +++ b/vsintegration/src/FSharp.Editor/BraceMatchingService.fs @@ -15,7 +15,7 @@ type internal FSharpBraceMatchingService() = let isPositionInRange(range) = let span = CommonRoslynHelpers.FSharpRangeToTextSpan(sourceText, range) span.Start <= position && position < span.End - let! matchedBraces = FSharpChecker.Instance.MatchBracesAlternate(fileName, sourceText.ToString(), options) + let! matchedBraces = FSharpLanguageService.Checker.MatchBracesAlternate(fileName, sourceText.ToString(), options) return matchedBraces |> Seq.tryFind(fun(left, right) -> isPositionInRange(left) || isPositionInRange(right)) } diff --git a/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs b/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs index c50ae6cba46..b776d03d724 100644 --- a/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs +++ b/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs @@ -32,7 +32,7 @@ open Microsoft.FSharp.Compiler.Range type internal FSharpBreakpointResolutionService() = static member GetBreakpointLocation(sourceText: SourceText, fileName: string, textSpan: TextSpan, options: FSharpProjectOptions) = async { - let! parseResults = FSharpChecker.Instance.ParseFileInProject(fileName, sourceText.ToString(), options) + let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(fileName, sourceText.ToString(), options) let textLine = sourceText.Lines.GetLineFromPosition(textSpan.Start) let textLineNumber = textLine.LineNumber + 1 // Roslyn line numbers are zero-based diff --git a/vsintegration/src/FSharp.Editor/ColorizationService.fs b/vsintegration/src/FSharp.Editor/ColorizationService.fs index 1ab24a9d0a0..e4ae973b2ee 100644 --- a/vsintegration/src/FSharp.Editor/ColorizationService.fs +++ b/vsintegration/src/FSharp.Editor/ColorizationService.fs @@ -149,9 +149,9 @@ type internal FSharpColorizationService() = match FSharpLanguageService.GetOptions(document.Project.Id) with | Some(options) -> let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask - let! parseResults = FSharpChecker.Instance.ParseFileInProject(document.Name, sourceText.ToString(), options) + let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(document.Name, sourceText.ToString(), options) let! textVersion = document.GetTextVersionAsync(cancellationToken) |> Async.AwaitTask - let! checkResultsAnswer = FSharpChecker.Instance.CheckFileInProject(parseResults, document.FilePath, textVersion.GetHashCode(), textSpan.ToString(), options) + let! checkResultsAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, document.FilePath, textVersion.GetHashCode(), textSpan.ToString(), options) let extraColorizationData = match checkResultsAnswer with | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet" diff --git a/vsintegration/src/FSharp.Editor/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/CompletionProvider.fs index 3c5c8878b34..f403fbc3731 100644 --- a/vsintegration/src/FSharp.Editor/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/CompletionProvider.fs @@ -73,8 +73,8 @@ type internal FSharpCompletionProvider(workspace: Workspace, serviceProvider: SV | _ -> true // anything else is a valid classification type static member ProvideCompletionsAsyncAux(sourceText: SourceText, caretPosition: int, options: FSharpProjectOptions, filePath: string, textVersionHash: int) = async { - let! parseResults = FSharpChecker.Instance.ParseFileInProject(filePath, sourceText.ToString(), options) - let! checkFileAnswer = FSharpChecker.Instance.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) + let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(filePath, sourceText.ToString(), options) + let! checkFileAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) let checkFileResults = match checkFileAnswer with | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet" | FSharpCheckFileAnswer.Succeeded(results) -> results diff --git a/vsintegration/src/FSharp.Editor/DocumentDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/DocumentDiagnosticAnalyzer.fs index 6eeb31ef073..c599df57638 100644 --- a/vsintegration/src/FSharp.Editor/DocumentDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/DocumentDiagnosticAnalyzer.fs @@ -25,10 +25,10 @@ type internal FSharpDocumentDiagnosticAnalyzer() = inherit DocumentDiagnosticAnalyzer() static member GetDiagnostics(filePath: string, sourceText: SourceText, textVersionHash: int, options: FSharpProjectOptions, addSemanticErrors: bool) = - let parseResults = FSharpChecker.Instance.ParseFileInProject(filePath, sourceText.ToString(), options) |> Async.RunSynchronously + let parseResults = FSharpLanguageService.Checker.ParseFileInProject(filePath, sourceText.ToString(), options) |> Async.RunSynchronously let errors = if addSemanticErrors then - let checkResultsAnswer = FSharpChecker.Instance.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) |> Async.RunSynchronously + let checkResultsAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) |> Async.RunSynchronously match checkResultsAnswer with | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet" | FSharpCheckFileAnswer.Succeeded(results) -> results.Errors diff --git a/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs b/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs index 62bc7bfd47b..6f36dc672fd 100644 --- a/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs +++ b/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs @@ -61,8 +61,8 @@ type internal FSharpGoToDefinitionService [] ([ Seq.tryFind(fun classifiedSpan -> classifiedSpan.TextSpan.Contains(position)) let processQualifiedIdentifier(qualifiers, islandColumn) = async { - let! parseResults = FSharpChecker.Instance.ParseFileInProject(filePath, sourceText.ToString(), options) - let! checkFileAnswer = FSharpChecker.Instance.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) + let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(filePath, sourceText.ToString(), options) + let! checkFileAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) let checkFileResults = match checkFileAnswer with | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet" | FSharpCheckFileAnswer.Succeeded(results) -> results @@ -103,12 +103,14 @@ type internal FSharpGoToDefinitionService [] ([ - let refDocumentId = document.Project.Solution.GetDocumentIdsWithFilePath(range.FileName).First() - let refDocument = document.Project.Solution.GetDocument(refDocumentId) - let! refSourceText = refDocument.GetTextAsync(cancellationToken) |> Async.AwaitTask - let refTextSpan = CommonRoslynHelpers.FSharpRangeToTextSpan(refSourceText, range) - let refDisplayString = refSourceText.GetSubText(refTextSpan).ToString() - results.Add(FSharpNavigableItem(refDocument, refTextSpan, refDisplayString)) + let refDocumentIds = document.Project.Solution.GetDocumentIdsWithFilePath(range.FileName) + if not refDocumentIds.IsEmpty then + let refDocumentId = refDocumentIds.First() + let refDocument = document.Project.Solution.GetDocument(refDocumentId) + let! refSourceText = refDocument.GetTextAsync(cancellationToken) |> Async.AwaitTask + let refTextSpan = CommonRoslynHelpers.FSharpRangeToTextSpan(refSourceText, range) + let refDisplayString = refSourceText.GetSubText(refTextSpan).ToString() + results.Add(FSharpNavigableItem(refDocument, refTextSpan, refDisplayString)) | None -> () | None -> () return results.AsEnumerable() diff --git a/vsintegration/src/FSharp.Editor/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService.fs index ce73f66b85e..aa1aac86c12 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService.fs @@ -49,6 +49,9 @@ type internal FSharpLanguageService(package : FSharpPackage) = inherit AbstractLanguageService(package) static let optionsCache = Dictionary() + static let checker = lazy FSharpChecker.Create() + static member Checker with get() = checker.Value + static member GetOptions(projectId: ProjectId) = if optionsCache.ContainsKey(projectId) then Some(optionsCache.[projectId]) @@ -118,7 +121,7 @@ type internal FSharpLanguageService(package : FSharpPackage) = | _ -> () member this.SetupStandAloneFile(fileName: string, fileContents: string, workspace: VisualStudioWorkspaceImpl, hier: IVsHierarchy) = - let options = FSharpChecker.Instance.GetProjectOptionsFromScript(fileName, fileContents, DateTime.Now, [| |]) |> Async.RunSynchronously + let options = FSharpLanguageService.Checker.GetProjectOptionsFromScript(fileName, fileContents, DateTime.Now, [| |]) |> Async.RunSynchronously let projectId = workspace.ProjectTracker.GetOrCreateProjectIdForPath(options.ProjectFileName, options.ProjectFileName) if not(optionsCache.ContainsKey(projectId)) then diff --git a/vsintegration/src/FSharp.Editor/ProjectDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/ProjectDiagnosticAnalyzer.fs index df1e56d07a7..f80b6944b36 100644 --- a/vsintegration/src/FSharp.Editor/ProjectDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/ProjectDiagnosticAnalyzer.fs @@ -26,7 +26,7 @@ type internal FSharpProjectDiagnosticAnalyzer() = inherit ProjectDiagnosticAnalyzer() static member GetDiagnostics(options: FSharpProjectOptions) = - let checkProjectResults = FSharpChecker.Instance.ParseAndCheckProject(options) |> Async.RunSynchronously + let checkProjectResults = FSharpLanguageService.Checker.ParseAndCheckProject(options) |> Async.RunSynchronously (checkProjectResults.Errors |> Seq.choose(fun (error) -> if error.StartLineAlternate = 0 || error.EndLineAlternate = 0 then Some(CommonRoslynHelpers.ConvertError(error, Location.None)) From 6cd468b418822ab0db94b323ee951826ab7c0346 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 23 Nov 2016 17:39:50 +0000 Subject: [PATCH 3/3] Fix cancellation and make more things async --- src/fsharp/vs/IncrementalBuild.fs | 85 +++++++++----- src/fsharp/vs/IncrementalBuild.fsi | 23 ++-- src/fsharp/vs/Reactor.fs | 1 + src/fsharp/vs/service.fs | 111 +++++++++--------- src/fsharp/vs/service.fsi | 14 +-- tests/service/EditorTests.fs | 42 +++++-- .../src/FSharp.Editor/BraceMatchingService.fs | 9 +- .../BreakpointResolutionService.fs | 12 +- .../src/FSharp.Editor/ColorizationService.fs | 11 +- .../src/FSharp.Editor/CommonRoslynHelpers.fs | 16 ++- .../src/FSharp.Editor/CompletionProvider.fs | 24 ++-- .../DocumentDiagnosticAnalyzer.fs | 44 +++---- .../FSharp.Editor/GoToDefinitionService.fs | 65 +++++----- .../FSharp.Editor/LanguageDebugInfoService.fs | 7 +- .../src/FSharp.Editor/LanguageService.fs | 9 +- .../ProjectDiagnosticAnalyzer.fs | 21 ++-- .../BackgroundRequests.fs | 8 +- .../DocumentDiagnosticAnalyzerTests.fs | 14 ++- .../ProjectDiagnosticAnalyzerTests.fs | 4 +- .../Tests.LanguageService.IncrementalBuild.fs | 66 +++++++---- 20 files changed, 328 insertions(+), 258 deletions(-) diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index cd87b3bb28e..5110eda78ea 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -6,6 +6,8 @@ namespace Microsoft.FSharp.Compiler open System open System.IO open System.Collections.Generic +open System.Threading +open System.Threading.Tasks open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.NameResolution open Microsoft.FSharp.Compiler.Tastops @@ -747,12 +749,26 @@ module internal IncrementalBuild = PartialBuild(bt.Rules, Map.add id (VectorResult(results)) bt.Results) | _ -> failwith "Unexpected" - let ExecuteApply (action:Action) bt = + let mutable injectCancellationFault = false + let LocallyInjectCancellationFault() = + injectCancellationFault <- true + { new IDisposable with member __.Dispose() = injectCancellationFault <- false } + + /// Apply the result, and call the 'save' function to update the build. + /// + /// Will throw OperationCanceledException if the cancellation token has been set. + let ExecuteApply save (ct: CancellationToken) (action:Action) bt = + ct.ThrowIfCancellationRequested() + if (injectCancellationFault) then raise (OperationCanceledException("injected fault")) let actionResult = action.Execute() - ApplyResult(actionResult,bt) + let newBt = ApplyResult(actionResult,bt) + save newBt + newBt /// Evaluate the result of a single output - let EvalLeafsFirst target bt = + /// + /// Will throw OperationCanceledException if the cancellation token has been set. + let EvalLeafsFirst save (ct: CancellationToken) target bt = let rec eval(bt,gen) = #if DEBUG @@ -760,31 +776,40 @@ module internal IncrementalBuild = // Possibly could detect this case directly. if gen>5000 then failwith "Infinite loop in incremental builder?" #endif - let newBt = ForeachAction target bt ExecuteApply bt - if newBt=bt then bt else eval(newBt,gen+1) + let newBt = ForeachAction target bt (ExecuteApply save ct) bt + if newBt=bt then bt else eval(newBt,gen+1) eval(bt,0) - let Step target (bt:PartialBuild) = + /// Evaluate one step of the build. Call the 'save' function to save the intermediate result. + /// + /// Will throw OperationCanceledException if the cancellation token has been set. + let Step save ct target (bt:PartialBuild) = // Hey look, we're building up the whole list, executing one thing and then throwing // the list away. What about saving the list inside the Build instance? let worklist = ForeachAction target bt (fun a l -> a :: l) [] match worklist with - | action::_ -> Some (ExecuteApply action bt) + | action::_ -> Some (ExecuteApply save ct action bt) | _ -> None /// Evaluate an output of the build. - let Eval node bt = EvalLeafsFirst (Target(node,None)) bt + /// + /// Will throw OperationCanceledException if the cancellation token has been set. Intermediate + /// progrewss along the way may be saved through the use of the 'save' function. + let Eval save ct node bt = EvalLeafsFirst save ct (Target(node,None)) bt /// Evaluate an output of the build. - let EvalUpTo (node, n) bt = EvalLeafsFirst (Target(node, Some n)) bt + /// + /// Will throw OperationCanceledException if the cancellation token has been set. Intermediate + /// progrewss along the way may be saved through the use of the 'save' function. + let EvalUpTo save ct (node, n) bt = EvalLeafsFirst save ct (Target(node, Some n)) bt /// Check if an output is up-to-date and ready let IsReady target bt = let worklist = ForeachAction target bt (fun a l -> a :: l) [] worklist.IsEmpty - + /// Check if an output is up-to-date and ready let MaxTimeStampInDependencies target bt = ComputeMaxTimeStamp target bt DateTime.MinValue @@ -1610,10 +1635,7 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig // This is the initial representation of progress through the build, i.e. we have made no progress. let mutable partialBuild = buildDescription.GetInitialPartialBuild buildInputs - let EvalAndKeepOutput f = - let newPartialBuild = f partialBuild - partialBuild <- newPartialBuild - newPartialBuild + let SavePartialBuild b = partialBuild <- b let MaxTimeStampInDependencies (output:INode) = IncrementalBuild.MaxTimeStampInDependencies output.Name partialBuild @@ -1650,16 +1672,15 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig | _ -> true #endif - member __.Step () = - match IncrementalBuild.Step (Target(tcStatesNode, None)) partialBuild with + member __.Step (ct) = + match IncrementalBuild.Step SavePartialBuild ct (Target(tcStatesNode, None)) partialBuild with | None -> projectChecked.Trigger() false - | Some newPartialBuild -> - partialBuild <- newPartialBuild + | Some _ -> true - member ib.GetCheckResultsBeforeFileInProjectIfReady filename: PartialCheckResults option = + member ib.GetCheckResultsBeforeFileInProjectIfReady (filename): PartialCheckResults option = let slotOfFile = ib.GetSlotOfFileName filename let result = match slotOfFile with @@ -1677,33 +1698,33 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig | (*first file*) 0 -> IncrementalBuild.IsReady (Target(initialTcAccNode, None)) partialBuild | _ -> IncrementalBuild.IsReady (Target(tcStatesNode, Some (slotOfFile-1))) partialBuild - member ib.GetCheckResultsBeforeFileInProject filename = + member ib.GetCheckResultsBeforeFileInProject (filename, ct) = let slotOfFile = ib.GetSlotOfFileName filename - ib.GetTypeCheckResultsBeforeSlotInProject slotOfFile + ib.GetTypeCheckResultsBeforeSlotInProject (slotOfFile, ct) - member ib.GetCheckResultsAfterFileInProject filename = + member ib.GetCheckResultsAfterFileInProject (filename, ct) = let slotOfFile = ib.GetSlotOfFileName filename + 1 - ib.GetTypeCheckResultsBeforeSlotInProject slotOfFile + ib.GetTypeCheckResultsBeforeSlotInProject (slotOfFile, ct) - member ib.GetTypeCheckResultsBeforeSlotInProject slotOfFile = + member ib.GetTypeCheckResultsBeforeSlotInProject (slotOfFile, ct) = let result = match slotOfFile with | (*first file*) 0 -> - let build = EvalAndKeepOutput (IncrementalBuild.Eval initialTcAccNode) + let build = IncrementalBuild.Eval SavePartialBuild ct initialTcAccNode partialBuild GetScalarResult(initialTcAccNode,build) | _ -> - let build = EvalAndKeepOutput (IncrementalBuild.EvalUpTo (tcStatesNode, (slotOfFile-1))) + let build = IncrementalBuild.EvalUpTo SavePartialBuild ct (tcStatesNode, (slotOfFile-1)) partialBuild GetVectorResultBySlot(tcStatesNode,slotOfFile-1,build) match result with | Some (tcAcc,timestamp) -> PartialCheckResults.Create (tcAcc,timestamp) | None -> failwith "Build was not evaluated, expected the results to be ready after 'Eval'." - member b.GetCheckResultsAfterLastFileInProject () = - b.GetTypeCheckResultsBeforeSlotInProject(b.GetSlotsCount()) + member b.GetCheckResultsAfterLastFileInProject (ct) = + b.GetTypeCheckResultsBeforeSlotInProject(b.GetSlotsCount(), ct) - member __.GetCheckResultsAndImplementationsForProject() = - let build = EvalAndKeepOutput (IncrementalBuild.Eval finalizedTypeCheckNode) + member __.GetCheckResultsAndImplementationsForProject(ct) = + let build = IncrementalBuild.Eval SavePartialBuild ct finalizedTypeCheckNode partialBuild match GetScalarResult(finalizedTypeCheckNode,build) with | Some ((ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, tcAcc), timestamp) -> PartialCheckResults.Create (tcAcc,timestamp), ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt @@ -1731,12 +1752,12 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig | Some (VectorResult vr) -> vr.Size | _ -> failwith "Failed to find sizes" - member ib.GetParseResultsForFile filename = + member ib.GetParseResultsForFile (filename, ct) = let slotOfFile = ib.GetSlotOfFileName filename match GetVectorResultBySlot(parseTreesNode,slotOfFile,partialBuild) with | Some (results, _) -> results | None -> - let build = EvalAndKeepOutput (IncrementalBuild.EvalUpTo (parseTreesNode, slotOfFile)) + let build = IncrementalBuild.EvalUpTo SavePartialBuild ct (parseTreesNode, slotOfFile) partialBuild match GetVectorResultBySlot(parseTreesNode,slotOfFile,build) with | Some (results, _) -> results | None -> failwith "Build was not evaluated, expcted the results to be ready after 'Eval'." diff --git a/src/fsharp/vs/IncrementalBuild.fsi b/src/fsharp/vs/IncrementalBuild.fsi index 1f194741a6d..5698b25b369 100755 --- a/src/fsharp/vs/IncrementalBuild.fsi +++ b/src/fsharp/vs/IncrementalBuild.fsi @@ -3,6 +3,8 @@ namespace Microsoft.FSharp.Compiler open System +open System.Threading +open System.Threading.Tasks open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.ErrorLogger @@ -142,7 +144,7 @@ type internal IncrementalBuilder = member ThereAreLiveTypeProviders : bool #endif /// Perform one step in the F# build. Return true if the background work is finished. - member Step : unit -> bool + member Step : ct: CancellationToken -> bool /// Get the preceding typecheck state of a slot, without checking if it is up-to-date w.r.t. /// the timestamps on files and referenced DLLs prior to this one. Return None if the result is not available. @@ -158,25 +160,25 @@ type internal IncrementalBuilder = /// to the necessary point if the result is not available. This may be a long-running operation. /// // TODO: make this an Eventually (which can be scheduled) or an Async (which can be cancelled) - member GetCheckResultsBeforeFileInProject : filename:string -> PartialCheckResults + member GetCheckResultsBeforeFileInProject : filename:string * ct: CancellationToken -> PartialCheckResults /// Get the typecheck state after checking a file. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. /// // TODO: make this an Eventually (which can be scheduled) or an Async (which can be cancelled) - member GetCheckResultsAfterFileInProject : filename:string -> PartialCheckResults + member GetCheckResultsAfterFileInProject : filename:string * ct: CancellationToken -> PartialCheckResults /// Get the typecheck result after the end of the last file. The typecheck of the project is not 'completed'. /// This may be a long-running operation. /// // TODO: make this an Eventually (which can be scheduled) or an Async (which can be cancelled) - member GetCheckResultsAfterLastFileInProject : unit -> PartialCheckResults + member GetCheckResultsAfterLastFileInProject : ct: CancellationToken -> PartialCheckResults /// Get the final typecheck result. If 'generateTypedImplFiles' was set on Create then the TypedAssemblyAfterOptimization will contain implementations. /// This may be a long-running operation. /// // TODO: make this an Eventually (which can be scheduled) or an Async (which can be cancelled) - member GetCheckResultsAndImplementationsForProject : unit -> PartialCheckResults * IL.ILAssemblyRef * IRawFSharpAssemblyData option * TypedImplFile list option + member GetCheckResultsAndImplementationsForProject : ct: CancellationToken -> PartialCheckResults * IL.ILAssemblyRef * IRawFSharpAssemblyData option * TypedImplFile list option /// Get the logical time stamp that is associated with the output of the project if it were gully built immediately member GetLogicalTimeStampForProject: unit -> DateTime @@ -184,7 +186,7 @@ type internal IncrementalBuilder = /// Await the untyped parse results for a particular slot in the vector of parse results. /// /// This may be a marginally long-running operation (parses are relatively quick, only one file needs to be parsed) - member GetParseResultsForFile : filename:string -> Ast.ParsedInput option * Range.range * string * (PhasedError * FSharpErrorSeverity) list + member GetParseResultsForFile : filename:string * ct: CancellationToken -> Ast.ParsedInput option * Range.range * string * (PhasedError * FSharpErrorSeverity) list static member TryCreateBackgroundBuilderForProjectOptions : ReferenceResolver.Resolver * FrameworkImportsCache * scriptClosureOptions:LoadClosure option * sourceFiles:string list * commandLineArgs:string list * projectReferences: IProjectReference list * projectDirectory:string * useScriptResolutionRules:bool * keepAssemblyContents: bool * keepAllBackgroundResolutions: bool -> IncrementalBuilder option * FSharpErrorInfo list @@ -242,14 +244,17 @@ module internal IncrementalBuild = type Target = Target of INode * int option + /// Used for unit testing. Causes all steps of underlying incremental graph evaluation to throw OperationCanceledException + val LocallyInjectCancellationFault : unit -> IDisposable + /// Evaluate a build. Only required for unit testing. - val Eval : INode -> PartialBuild -> PartialBuild + val Eval : (PartialBuild -> unit) -> CancellationToken -> INode -> PartialBuild -> PartialBuild /// Evaluate a build for a vector up to a limit. Only required for unit testing. - val EvalUpTo : INode * int -> PartialBuild -> PartialBuild + val EvalUpTo : (PartialBuild -> unit) -> CancellationToken -> INode * int -> PartialBuild -> PartialBuild /// Do one step in the build. Only required for unit testing. - val Step : Target -> PartialBuild -> PartialBuild option + val Step : (PartialBuild -> unit) -> CancellationToken -> Target -> PartialBuild -> PartialBuild option /// Get a scalar vector. Result must be available. Only required for unit testing. val GetScalarResult : Scalar<'T> * PartialBuild -> ('T * System.DateTime) option /// Get a result vector. All results must be available or thrown an exception. Only required for unit testing. diff --git a/src/fsharp/vs/Reactor.fs b/src/fsharp/vs/Reactor.fs index 6c5c27d2a9e..47d79518090 100755 --- a/src/fsharp/vs/Reactor.fs +++ b/src/fsharp/vs/Reactor.fs @@ -141,6 +141,7 @@ type Reactor() = try f ct |> AsyncUtil.AsyncOk with + | :? OperationCanceledException as e -> AsyncUtil.AsyncCanceled e | e -> e |> AsyncUtil.AsyncException resultCell.RegisterResult(result)), ccont=(fun () -> resultCell.RegisterResult (AsyncUtil.AsyncCanceled(OperationCanceledException())) ) diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 8945c607213..e63317e1dec 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1571,7 +1571,7 @@ module internal Parser = reactorOps: IReactorOperations, // Used by 'FSharpDeclarationListInfo' to check the IncrementalBuilder is still alive. checkAlive : (unit -> bool), - isResultObsolete: unit->bool, + cancellationToken: CancellationToken, textSnapshotInfo : obj option) = match parseResults.ParseTree with @@ -1666,7 +1666,7 @@ module internal Parser = // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance // for the client to claim the result as obsolete and have the typecheck abort. let computation = TypeCheckOneInputAndFinishEventually(checkForErrors,tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) - match computation |> Eventually.forceWhile (fun () -> not (isResultObsolete())) with + match computation |> Eventually.forceWhile (fun () -> not cancellationToken.IsCancellationRequested) with | Some((tcEnvAtEnd,_,typedImplFiles),tcState) -> Some (tcEnvAtEnd, typedImplFiles, tcState) | None -> None // Means 'aborted' with @@ -2049,16 +2049,16 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent /// CreateOneIncrementalBuilder (for background type checking). Note that fsc.fs also /// creates an incremental builder used by the command line compiler. - let CreateOneIncrementalBuilder (options:FSharpProjectOptions) = + let CreateOneIncrementalBuilder (options:FSharpProjectOptions, ct) = let projectReferences = [ for (nm,opts) in options.ReferencedProjects -> { new IProjectReference with member x.EvaluateRawContents() = - let r = self.ParseAndCheckProjectImpl(opts) + let r = self.ParseAndCheckProjectImpl(opts, ct) r.RawFSharpAssemblyData member x.GetLogicalTimeStamp() = - self.GetLogicalTimeStampForProject(opts) + self.GetLogicalTimeStampForProject(opts, ct) member x.FileName = nm } ] let builderOpt, errorsAndWarnings = @@ -2104,11 +2104,11 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent requiredToKeep=(fun (builderOpt,_,_) -> match builderOpt with None -> false | Some b -> b.IsBeingKeptAliveApartFromCacheEntry), onDiscard = (fun (_, _, decrement) -> decrement.Dispose())) - let getOrCreateBuilder options = + let getOrCreateBuilder (options, ct) = match incrementalBuildersCache.TryGet options with | Some b -> b | None -> - let b = CreateOneIncrementalBuilder options + let b = CreateOneIncrementalBuilder (options, ct) incrementalBuildersCache.Set (options, b) b @@ -2193,7 +2193,7 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent match cachedResults with | Some (parseResults, _checkResults,_,_) -> async.Return parseResults | _ -> - reactor.EnqueueAndAwaitOpAsync("ParseFileInProject " + filename, fun _ct -> + reactor.EnqueueAndAwaitOpAsync("ParseFileInProject " + filename, fun ct -> // Try the caches again - it may have been filled by the time this operation runs match locked (fun () -> parseFileInProjectCache.TryGet (filename, source, options)) with @@ -2204,7 +2204,7 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent | Some (parseResults, _checkResults,_,_) -> parseResults | _ -> foregroundParseCount <- foregroundParseCount + 1 - let builderOpt,creationErrors,_ = getOrCreateBuilder options + let builderOpt,creationErrors,_ = getOrCreateBuilder (options, ct) use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> FSharpParseFileResults(List.toArray creationErrors, None, true, []) @@ -2220,21 +2220,21 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) member bc.GetBackgroundParseResultsForFileInProject(filename, options) = - reactor.EnqueueAndAwaitOpAsync("GetBackgroundParseResultsForFileInProject " + filename, fun _ct -> - let builderOpt, creationErrors, _ = getOrCreateBuilder options + reactor.EnqueueAndAwaitOpAsync("GetBackgroundParseResultsForFileInProject " + filename, fun ct -> + let builderOpt, creationErrors, _ = getOrCreateBuilder (options, ct) use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> FSharpParseFileResults(List.toArray creationErrors, None, true, []) | Some builder -> - let inputOpt,_,_,parseErrors = builder.GetParseResultsForFile filename + let inputOpt,_,_,parseErrors = builder.GetParseResultsForFile (filename, ct) let dependencyFiles = builder.Dependencies let errors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, parseErrors) |] FSharpParseFileResults(errors = errors, input = inputOpt, parseHadErrors = false, dependencyFiles = dependencyFiles) ) member bc.MatchBraces(filename:string, source, options)= - reactor.EnqueueAndAwaitOpAsync("MatchBraces " + filename, fun _ct -> - let builderOpt,_,_ = getOrCreateBuilder options + reactor.EnqueueAndAwaitOpAsync("MatchBraces " + filename, fun ct -> + let builderOpt,_,_ = getOrCreateBuilder (options, ct) use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> [| |] @@ -2261,8 +2261,8 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent | _ -> None /// Type-check the result obtained by parsing, but only if the antecedent type checking context is available. - member bc.CheckFileInProjectIfReady(parseResults:FSharpParseFileResults,filename,fileVersion,source,options,isResultObsolete,textSnapshotInfo:obj option) = - reactor.EnqueueAndAwaitOpAsync("CheckFileInProjectIfReady " + filename, fun _ct -> + member bc.CheckFileInProjectIfReady(parseResults:FSharpParseFileResults,filename,fileVersion,source,options,textSnapshotInfo:obj option) = + reactor.EnqueueAndAwaitOpAsync("CheckFileInProjectIfReady " + filename, fun ct -> let answer = match incrementalBuildersCache.TryGetAny options with | Some(Some builder, creationErrors, _) -> @@ -2277,10 +2277,11 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent // For scripts, this will have been recorded by GetProjectOptionsFromScript. let loadClosure = scriptClosureCache.TryGet options + let checkAlive () = builder.IsAlive // Run the type checking. let tcErrors, tcFileResult = Parser.TypeCheckOneFile(parseResults,source,filename,options.ProjectFileName,tcPrior.TcConfig,tcPrior.TcGlobals,tcPrior.TcImports, tcPrior.TcState, - loadClosure,tcPrior.Errors,reactorOps,(fun () -> builder.IsAlive),isResultObsolete,textSnapshotInfo) + loadClosure,tcPrior.Errors,reactorOps,checkAlive,ct,textSnapshotInfo) let checkAnswer = MakeCheckFileAnswer(tcFileResult, options, builder, creationErrors, parseResults.Errors, tcErrors) bc.RecordTypeCheckFileInProjectResults(filename,options,parseResults,fileVersion,tcPrior.TimeStamp,Some checkAnswer,source) @@ -2292,9 +2293,9 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent /// Type-check the result obtained by parsing. Force the evaluation of the antecedent type checking context if needed. - member bc.CheckFileInProject(parseResults:FSharpParseFileResults,filename,fileVersion,source,options,isResultObsolete,textSnapshotInfo) = - reactor.EnqueueAndAwaitOpAsync("CheckFileInProject " + filename, fun _ct -> - let builderOpt,creationErrors,_ = getOrCreateBuilder options + member bc.CheckFileInProject(parseResults:FSharpParseFileResults,filename,fileVersion,source,options,textSnapshotInfo) = + reactor.EnqueueAndAwaitOpAsync("CheckFileInProject " + filename, fun ct -> + let builderOpt,creationErrors,_ = getOrCreateBuilder (options, ct) use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> FSharpCheckFileAnswer.Succeeded (MakeCheckFileResultsEmpty(creationErrors)) @@ -2305,11 +2306,11 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent match bc.GetCachedCheckFileResult(builder,filename,source,options) with | Some (_parseResults, checkResults) -> FSharpCheckFileAnswer.Succeeded checkResults | _ -> - let tcPrior = builder.GetCheckResultsBeforeFileInProject filename + let tcPrior = builder.GetCheckResultsBeforeFileInProject (filename, ct) let loadClosure = scriptClosureCache.TryGet options let tcErrors, tcFileResult = Parser.TypeCheckOneFile(parseResults,source,filename,options.ProjectFileName,tcPrior.TcConfig,tcPrior.TcGlobals,tcPrior.TcImports, tcPrior.TcState, - loadClosure,tcPrior.Errors,reactorOps,(fun () -> builder.IsAlive),isResultObsolete,textSnapshotInfo) + loadClosure,tcPrior.Errors,reactorOps,(fun () -> builder.IsAlive),ct,textSnapshotInfo) let checkAnswer = MakeCheckFileAnswer(tcFileResult, options, builder, creationErrors, parseResults.Errors, tcErrors) bc.RecordTypeCheckFileInProjectResults(filename,options,parseResults,fileVersion,tcPrior.TimeStamp,Some checkAnswer,source) bc.ImplicitlyStartCheckProjectInBackground(options) @@ -2317,9 +2318,9 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent ) /// Parses the source file and returns untyped AST - member bc.ParseAndCheckFileInProject(filename:string, fileVersion, source, options:FSharpProjectOptions,isResultObsolete,textSnapshotInfo) = - reactor.EnqueueAndAwaitOpAsync("ParseAndCheckFileInProject " + filename, fun _ct -> - let builderOpt,creationErrors,_ = getOrCreateBuilder options // Q: Whis it it ok to ignore creationErrors in the build cache? A: These errors will be appended into the typecheck results + member bc.ParseAndCheckFileInProject(filename:string, fileVersion, source, options:FSharpProjectOptions,textSnapshotInfo) = + reactor.EnqueueAndAwaitOpAsync("ParseAndCheckFileInProject " + filename, fun ct -> + let builderOpt,creationErrors,_ = getOrCreateBuilder (options, ct) // Q: Whis it it ok to ignore creationErrors in the build cache? A: These errors will be appended into the typecheck results use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> @@ -2330,7 +2331,7 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent match bc.GetCachedCheckFileResult(builder,filename,source,options) with | Some (parseResults, checkResults) -> parseResults, FSharpCheckFileAnswer.Succeeded checkResults | _ -> - let tcPrior = builder.GetCheckResultsBeforeFileInProject filename + let tcPrior = builder.GetCheckResultsBeforeFileInProject (filename, ct) // Do the parsing. let parseErrors, _matchPairs, inputOpt, anyErrors = Parser.ParseOneFile (source, false, true, filename, builder.ProjectFileNames, builder.TcConfig) @@ -2339,7 +2340,7 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent let loadClosure = scriptClosureCache.TryGet options let tcErrors, tcFileResult = Parser.TypeCheckOneFile(parseResults,source,filename,options.ProjectFileName,tcPrior.TcConfig,tcPrior.TcGlobals,tcPrior.TcImports, tcPrior.TcState, - loadClosure,tcPrior.Errors,reactorOps,(fun () -> builder.IsAlive),isResultObsolete,textSnapshotInfo) + loadClosure,tcPrior.Errors,reactorOps,(fun () -> builder.IsAlive),ct,textSnapshotInfo) let checkAnswer = MakeCheckFileAnswer(tcFileResult, options, builder, creationErrors, parseResults.Errors, tcErrors) bc.RecordTypeCheckFileInProjectResults(filename,options,parseResults,fileVersion,tcPrior.TimeStamp,Some checkAnswer,source) bc.ImplicitlyStartCheckProjectInBackground(options) @@ -2348,8 +2349,8 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) member bc.GetBackgroundCheckResultsForFileInProject(filename,options) = - reactor.EnqueueAndAwaitOpAsync("GetBackgroundCheckResultsForFileInProject " + filename, fun _ct -> - let (builderOpt, creationErrors, _) = getOrCreateBuilder options + reactor.EnqueueAndAwaitOpAsync("GetBackgroundCheckResultsForFileInProject " + filename, fun ct -> + let (builderOpt, creationErrors, _) = getOrCreateBuilder (options, ct) use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> @@ -2357,8 +2358,8 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent let typedResults = MakeCheckFileResultsEmpty(creationErrors) (parseResults, typedResults) | Some builder -> - let (inputOpt, _, _, untypedErrors) = builder.GetParseResultsForFile filename - let tcProj = builder.GetCheckResultsAfterFileInProject filename + let (inputOpt, _, _, untypedErrors) = builder.GetParseResultsForFile (filename, ct) + let tcProj = builder.GetCheckResultsAfterFileInProject (filename, ct) let untypedErrors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, untypedErrors) |] let tcErrors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (builder.TcConfig, false, filename, tcProj.Errors) |] let parseResults = FSharpParseFileResults(errors = untypedErrors, input = inputOpt, parseHadErrors = false, dependencyFiles = builder.Dependencies) @@ -2386,20 +2387,20 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent | None -> locked (fun () -> parseAndCheckFileInProjectCachePossiblyStale.TryGet((filename,options))) /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) - member private bc.ParseAndCheckProjectImpl(options) : FSharpCheckProjectResults = - let builderOpt,creationErrors,_ = getOrCreateBuilder options + member private bc.ParseAndCheckProjectImpl(options, ct) : FSharpCheckProjectResults = + let builderOpt,creationErrors,_ = getOrCreateBuilder (options, ct) use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> FSharpCheckProjectResults (keepAssemblyContents, Array.ofList creationErrors, None, reactorOps) | Some builder -> - let (tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt) = builder.GetCheckResultsAndImplementationsForProject() + let (tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt) = builder.GetCheckResultsAndImplementationsForProject(ct) let errors = [| yield! creationErrors; yield! Parser.CreateErrorInfos (tcProj.TcConfig, true, Microsoft.FSharp.Compiler.TcGlobals.DummyFileNameForRangesWithoutASpecificLocation, tcProj.Errors) |] FSharpCheckProjectResults (keepAssemblyContents, errors, Some(tcProj.TcGlobals, tcProj.TcImports, tcProj.TcState.Ccu, tcProj.TcState.PartialAssemblySignature, tcProj.TcSymbolUses, tcProj.TopAttribs, tcAssemblyDataOpt, ilAssemRef, tcProj.TcEnvAtEnd.AccessRights, tcAssemblyExprOpt), reactorOps) /// Get the timestamp that would be on the output if fully built immediately - member private bc.GetLogicalTimeStampForProject(options) = - let builderOpt,_creationErrors,_ = getOrCreateBuilder options + member private bc.GetLogicalTimeStampForProject(options, ct) = + let builderOpt,_creationErrors,_ = getOrCreateBuilder (options, ct) use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> None @@ -2407,14 +2408,14 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent /// Keep the projet builder alive over a scope member bc.KeepProjectAlive(options) = - reactor.EnqueueAndAwaitOpAsync("KeepProjectAlive " + options.ProjectFileName, fun _ct -> - let builderOpt,_creationErrors,_ = getOrCreateBuilder options + reactor.EnqueueAndAwaitOpAsync("KeepProjectAlive " + options.ProjectFileName, fun ct -> + let builderOpt,_creationErrors,_ = getOrCreateBuilder (options, ct) // This increments, and lets the caller decrement IncrementalBuilder.KeepBuilderAlive builderOpt) /// Parse and typecheck the whole project. member bc.ParseAndCheckProject(options) = - reactor.EnqueueAndAwaitOpAsync("ParseAndCheckProject " + options.ProjectFileName, fun _ct -> bc.ParseAndCheckProjectImpl(options)) + reactor.EnqueueAndAwaitOpAsync("ParseAndCheckProject " + options.ProjectFileName, fun ct -> bc.ParseAndCheckProjectImpl(options, ct)) member bc.GetProjectOptionsFromScript(filename, source, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?assumeDotNetFramework) = reactor.EnqueueAndAwaitOpAsync ("GetProjectOptionsFromScript " + filename, fun _ct -> @@ -2457,12 +2458,14 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent member bc.InvalidateConfiguration(options : FSharpProjectOptions) = reactor.EnqueueOp("InvalidateConfiguration", fun () -> + // This operation can't currently be cancelled and is not async + let ct = CancellationToken.None match incrementalBuildersCache.TryGetAny options with | None -> () | Some (_oldBuilder, _, _) -> // We do not need to decrement here - the onDiscard function is called each time an entry is pushed out of the build cache, // including by SetAlternate. - let builderB, errorsB, decrementB = CreateOneIncrementalBuilder options + let builderB, errorsB, decrementB = CreateOneIncrementalBuilder (options, ct) incrementalBuildersCache.Set(options, (builderB, errorsB, decrementB)) if implicitlyStartBackgroundWork then bc.CheckProjectInBackground(options)) @@ -2481,11 +2484,13 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent member bc.CheckProjectInBackground(options) = reactor.SetBackgroundOp(Some(fun () -> - let builderOpt,_,_ = getOrCreateBuilder options + // The individual steps of the background build can't currently be cancelled + let ct = CancellationToken.None + let builderOpt,_,_ = getOrCreateBuilder (options, ct) use _unwind = IncrementalBuilder.KeepBuilderAlive builderOpt match builderOpt with | None -> false - | Some builder -> builder.Step())) + | Some builder -> builder.Step(ct))) member bc.StopBackgroundCompile() = reactor.SetBackgroundOp(None) @@ -2618,21 +2623,18 @@ type FSharpChecker(referenceResolver, projectCacheSize, keepAssemblyContents, ke /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. - member ic.CheckFileInProjectIfReady(parseResults:FSharpParseFileResults, filename:string, fileVersion:int, source:string, options:FSharpProjectOptions, ?isResultObsolete, ?textSnapshotInfo:obj) = - let (IsResultObsolete(isResultObsolete)) = defaultArg isResultObsolete (IsResultObsolete(fun _ -> false)) - backgroundCompiler.CheckFileInProjectIfReady(parseResults,filename,fileVersion,source,options,isResultObsolete,textSnapshotInfo) + member ic.CheckFileInProjectIfReady(parseResults:FSharpParseFileResults, filename:string, fileVersion:int, source:string, options:FSharpProjectOptions, ?textSnapshotInfo:obj) = + backgroundCompiler.CheckFileInProjectIfReady(parseResults,filename,fileVersion,source,options,textSnapshotInfo) /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. - member ic.CheckFileInProject(parseResults:FSharpParseFileResults, filename:string, fileVersion:int, source:string, options:FSharpProjectOptions, ?isResultObsolete, ?textSnapshotInfo:obj) = - let (IsResultObsolete(isResultObsolete)) = defaultArg isResultObsolete (IsResultObsolete(fun _ -> false)) - backgroundCompiler.CheckFileInProject(parseResults,filename,fileVersion,source,options,isResultObsolete,textSnapshotInfo) + member ic.CheckFileInProject(parseResults:FSharpParseFileResults, filename:string, fileVersion:int, source:string, options:FSharpProjectOptions, ?textSnapshotInfo:obj) = + backgroundCompiler.CheckFileInProject(parseResults,filename,fileVersion,source,options,textSnapshotInfo) /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. - member ic.ParseAndCheckFileInProject(filename:string, fileVersion:int, source:string, options:FSharpProjectOptions, ?isResultObsolete, ?textSnapshotInfo:obj) = - let (IsResultObsolete(isResultObsolete)) = defaultArg isResultObsolete (IsResultObsolete(fun _ -> false)) - backgroundCompiler.ParseAndCheckFileInProject(filename, fileVersion, source, options, isResultObsolete, textSnapshotInfo) + member ic.ParseAndCheckFileInProject(filename:string, fileVersion:int, source:string, options:FSharpProjectOptions, ?textSnapshotInfo:obj) = + backgroundCompiler.ParseAndCheckFileInProject(filename, fileVersion, source, options, textSnapshotInfo) member ic.ParseAndCheckProject(options) = backgroundCompiler.ParseAndCheckProject(options) @@ -2694,8 +2696,8 @@ type FSharpChecker(referenceResolver, projectCacheSize, keepAssemblyContents, ke bc.ParseFileInProject(filename, source, options) |> Async.RunSynchronously - member bc.TypeCheckSource(parseResults, filename, fileVersion, source, options, isResultObsolete, textSnapshotInfo:obj) = - bc.CheckFileInProjectIfReady(parseResults, filename, fileVersion, source, options, isResultObsolete, textSnapshotInfo) + member bc.TypeCheckSource(parseResults, filename, fileVersion, source, options, textSnapshotInfo:obj) = + bc.CheckFileInProjectIfReady(parseResults, filename, fileVersion, source, options, textSnapshotInfo) |> Async.RunSynchronously member ic.GetCheckOptionsFromScriptRoot(filename, source, loadedTimeStamp) = @@ -2731,9 +2733,10 @@ type FsiInteractiveChecker(reactorOps: IReactorOperations, tcConfig, tcGlobals, let parseResults = FSharpParseFileResults(parseErrors, inputOpt, parseHadErrors = anyErrors, dependencyFiles = dependencyFiles) let backgroundErrors = [] + let ct = CancellationToken.None let tcErrors, tcFileResult = Parser.TypeCheckOneFile(parseResults,source,mainInputFileName,"project",tcConfig,tcGlobals,tcImports, tcState, - loadClosure,backgroundErrors,reactorOps,(fun () -> true),(fun _ -> false),None) + loadClosure,backgroundErrors,reactorOps,(fun () -> true),ct,None) match tcFileResult with | Parser.TypeCheckAborted.No scope -> diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 201c8e97a56..b74805915fb 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -312,16 +312,10 @@ type internal FSharpProjectOptions = } -/// Callback which can be used by the host to indicate to the checker that a requested result has become obsolete, -/// e.g. because of typing by the user in the editor window. This can be used to marginally increase accuracy -/// of intellisense results in some situations. -type internal IsResultObsolete = - | IsResultObsolete of (unit->bool) - /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. [] type internal FSharpCheckFileAnswer = - | Aborted // because isResultObsolete caused an abandonment of the operation + | Aborted // because cancellation caused an abandonment of the operation | Succeeded of FSharpCheckFileResults [] @@ -383,7 +377,7 @@ type internal FSharpChecker = /// can be used to marginally increase accuracy of intellisense results in some situations. /// /// - member CheckFileInProjectIfReady : parsed: FSharpParseFileResults * filename: string * fileversion: int * source: string * options: FSharpProjectOptions * ?isResultObsolete: IsResultObsolete * ?textSnapshotInfo: obj -> Async + member CheckFileInProjectIfReady : parsed: FSharpParseFileResults * filename: string * fileversion: int * source: string * options: FSharpProjectOptions * ?textSnapshotInfo: obj -> Async /// /// @@ -413,7 +407,7 @@ type internal FSharpChecker = /// can be used to marginally increase accuracy of intellisense results in some situations. /// /// - member CheckFileInProject : parsed: FSharpParseFileResults * filename: string * fileversion: int * source: string * options: FSharpProjectOptions * ?isResultObsolete: IsResultObsolete * ?textSnapshotInfo: obj -> Async + member CheckFileInProject : parsed: FSharpParseFileResults * filename: string * fileversion: int * source: string * options: FSharpProjectOptions * ?textSnapshotInfo: obj -> Async /// /// @@ -442,7 +436,7 @@ type internal FSharpChecker = /// can be used to marginally increase accuracy of intellisense results in some situations. /// /// - member ParseAndCheckFileInProject : filename: string * fileversion: int * source: string * options: FSharpProjectOptions * ?isResultObsolete: IsResultObsolete * ?textSnapshotInfo: obj -> Async + member ParseAndCheckFileInProject : filename: string * fileversion: int * source: string * options: FSharpProjectOptions * ?textSnapshotInfo: obj -> Async /// /// Parse and typecheck all files in a project. diff --git a/tests/service/EditorTests.fs b/tests/service/EditorTests.fs index a0d671fc94d..4a01ffcfc5a 100644 --- a/tests/service/EditorTests.fs +++ b/tests/service/EditorTests.fs @@ -5,13 +5,15 @@ // // Technique 2: // -// Compile this file as an EXE that has InternalsVisibleTo access into the +// Enable some tests in the #if EXE section at the end of the file, +// then compile this file as an EXE that has InternalsVisibleTo access into the // appropriate DLLs. This can be the quickest way to get turnaround on updating the tests // and capturing large amounts of structured output. -// cd Debug\net40\bin -// .\fsc.exe --define:EXE -o VisualFSharp.Unittests.exe -g --optimize- -r .\FSharp.LanguageService.Compiler.dll -r nunit.framework.dll ..\..\..\tests\service\FsUnit.fs ..\..\..\tests\service\Common.fs /delaysign /keyfile:..\..\..\src\fsharp\msft.pubkey ..\..\..\tests\service\EditorTests.fs -// .\VisualFSharp.Unittests.exe -// +(* + cd Debug\net40\bin + .\fsc.exe --define:EXE -r:.\Microsoft.Build.Utilities.Core.dll -o SomeTests.exe -g --optimize- -r .\FSharp.LanguageService.Compiler.dll -r nunit.framework.dll ..\..\..\tests\service\FsUnit.fs ..\..\..\tests\service\Common.fs /delaysign /keyfile:..\..\..\src\fsharp\msft.pubkey ..\..\..\tests\service\EditorTests.fs + .\SomeTests.exe +*) // Technique 3: // // Use F# Interactive. This only works for FSHarp.Compiler.Service.dll which has a public API @@ -94,6 +96,26 @@ let ``Intro test`` () = ("Concat", ["arg0: obj"; "arg1: obj"; "arg2: obj"; "arg3: obj"]); ("Concat", ["str0: string"; "str1: string"; "str2: string"; "str3: string"])] + +[] +let ``Basic cancellation test`` () = + try + printfn "locally injecting a cancellation condition in incremental building" + use _holder = IncrementalBuild.LocallyInjectCancellationFault() + + // Split the input & define file name + let inputLines = input.Split('\n') + let file = "/home/user/Test.fsx" + async { + checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() + let! checkOptions = checker.GetProjectOptionsFromScript(file, input) + let! parseResult, typedRes = checker.ParseAndCheckFileInProject(file, 0, input, checkOptions) + return parseResult, typedRes + } |> Async.RunSynchronously + |> ignore + Assert.Fail("expected a cancellation") + with :? OperationCanceledException -> () + [] let ``GetMethodsAsSymbols should return all overloads of a method as FSharpSymbolUse`` () = @@ -715,8 +737,10 @@ let ``Test TPProject param info`` () = #if EXE ``Intro test`` () -``Test TPProject all symbols`` () -``Test TPProject errors`` () -``Test TPProject quick info`` () -``Test TPProject param info`` () +//``Test TPProject all symbols`` () +//``Test TPProject errors`` () +//``Test TPProject quick info`` () +//``Test TPProject param info`` () +``Basic cancellation test`` () +``Intro test`` () #endif diff --git a/vsintegration/src/FSharp.Editor/BraceMatchingService.fs b/vsintegration/src/FSharp.Editor/BraceMatchingService.fs index 10b4d0c0cc8..359fcf4b3d1 100644 --- a/vsintegration/src/FSharp.Editor/BraceMatchingService.fs +++ b/vsintegration/src/FSharp.Editor/BraceMatchingService.fs @@ -21,8 +21,8 @@ type internal FSharpBraceMatchingService() = } interface IBraceMatcher with - member this.FindBracesAsync(document, position, cancellationToken) = - let computation = async { + member this.FindBracesAsync(document, position, cancellationToken) = + async { match FSharpLanguageService.GetOptions(document.Project.Id) with | Some(options) -> let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask @@ -34,7 +34,4 @@ type internal FSharpBraceMatchingService() = CommonRoslynHelpers.FSharpRangeToTextSpan(sourceText, left), CommonRoslynHelpers.FSharpRangeToTextSpan(sourceText, right))) | None -> return Nullable() - } - - Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) - .ContinueWith(CommonRoslynHelpers.GetCompletedTaskResult, cancellationToken) + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken diff --git a/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs b/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs index 74ea40ad046..9c7d6b7bee1 100644 --- a/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs +++ b/vsintegration/src/FSharp.Editor/BreakpointResolutionService.fs @@ -32,6 +32,11 @@ open Microsoft.FSharp.Compiler.Range type internal FSharpBreakpointResolutionService() = static member GetBreakpointLocation(sourceText: SourceText, fileName: string, textSpan: TextSpan, options: FSharpProjectOptions) = async { + // REVIEW: ParseFileInProject can cause FSharp.Compiler.Service to become unavailable (i.e. not responding to requests) for + // an arbitrarily long time while it parses all files prior to this one in the project (plus dependent projects if we enable + // cross-project checking in multi-project solutions). FCS will not respond to other + // requests unless this task is cancelled. We need to check that this task is cancelled in a timely way by the + // Roslyn UI machinery. let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(fileName, sourceText.ToString(), options) let textLinePos = sourceText.Lines.GetLinePosition(textSpan.Start) let textLineColumn = textLinePos.Character @@ -42,7 +47,7 @@ type internal FSharpBreakpointResolutionService() = interface IBreakpointResolutionService with member this.ResolveBreakpointAsync(document: Document, textSpan: TextSpan, cancellationToken: CancellationToken): Task = - let computation = async { + async { match FSharpLanguageService.GetOptions(document.Project.Id) with | Some(options) -> let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask @@ -51,10 +56,7 @@ type internal FSharpBreakpointResolutionService() = | None -> null | Some(range) -> BreakpointResolutionResult.CreateSpanResult(document, CommonRoslynHelpers.FSharpRangeToTextSpan(sourceText, range)) | None -> return null - } - - Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) - .ContinueWith(CommonRoslynHelpers.GetCompletedTaskResult, cancellationToken) + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken // FSROSLYNTODO: enable placing breakpoints by when user suplies fully-qualified function names member this.ResolveBreakpointsAsync(_, _, _): Task> = diff --git a/vsintegration/src/FSharp.Editor/ColorizationService.fs b/vsintegration/src/FSharp.Editor/ColorizationService.fs index e4ae973b2ee..74ddcf2646c 100644 --- a/vsintegration/src/FSharp.Editor/ColorizationService.fs +++ b/vsintegration/src/FSharp.Editor/ColorizationService.fs @@ -145,10 +145,15 @@ type internal FSharpColorizationService() = , cancellationToken) member this.AddSemanticClassificationsAsync(document: Document, textSpan: TextSpan, result: List, cancellationToken: CancellationToken) = - let computation = async { + async { match FSharpLanguageService.GetOptions(document.Project.Id) with | Some(options) -> let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask + // REVIEW: ParseFileInProject and CheckFileInProject can cause FSharp.Compiler.Service to become unavailable (i.e. not responding to requests) for + // an arbitrarily long time while they process all files prior to this one in the project (plus dependent projects if we enable + // cross-project checking in multi-project solutions). FCS will not respond to other + // requests unless this task is cancelled. We need to check that this task is cancelled in a timely way by the + // Roslyn UI machinery. let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(document.Name, sourceText.ToString(), options) let! textVersion = document.GetTextVersionAsync(cancellationToken) |> Async.AwaitTask let! checkResultsAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, document.FilePath, textVersion.GetHashCode(), textSpan.ToString(), options) @@ -161,9 +166,7 @@ type internal FSharpColorizationService() = result.AddRange(extraColorizationData) | None -> () - } - - Task.Run(CommonRoslynHelpers.GetTaskAction(computation), cancellationToken) + } |> CommonRoslynHelpers.StartAsyncUnitAsTask cancellationToken // Do not perform classification if we don't have project options (#defines matter) member this.AdjustStaleClassification(_: SourceText, classifiedSpan: ClassifiedSpan) : ClassifiedSpan = classifiedSpan diff --git a/vsintegration/src/FSharp.Editor/CommonRoslynHelpers.fs b/vsintegration/src/FSharp.Editor/CommonRoslynHelpers.fs index 13bdda569c5..8e9bc510eb0 100644 --- a/vsintegration/src/FSharp.Editor/CommonRoslynHelpers.fs +++ b/vsintegration/src/FSharp.Editor/CommonRoslynHelpers.fs @@ -20,15 +20,6 @@ module internal CommonRoslynHelpers = let endPosition = sourceText.Lines.[range.EndLine - 1].Start + range.EndColumn TextSpan(startPosition, endPosition - startPosition) - let GetTaskAction(computation: Async) = - // Shortcut due to nonstandard way of converting Async to Task - let action() = - try - computation |> Async.RunSynchronously - with ex -> - Assert.Exception(ex.GetBaseException()) - raise(ex.GetBaseException()) - Action action let GetCompletedTaskResult(task: Task<'TResult>) = if task.Status = TaskStatus.RanToCompletion then @@ -37,6 +28,13 @@ module internal CommonRoslynHelpers = Assert.Exception(task.Exception.GetBaseException()) raise(task.Exception.GetBaseException()) + let StartAsyncAsTask cancellationToken computation = + Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) + .ContinueWith(GetCompletedTaskResult, cancellationToken) + + let StartAsyncUnitAsTask cancellationToken (computation:Async) = + StartAsyncAsTask cancellationToken computation :> Task + let SupportedDiagnostics() = // We are constructing our own descriptors at run-time. Compiler service is already doing error formatting and localization. let dummyDescriptor = DiagnosticDescriptor("0", String.Empty, String.Empty, String.Empty, DiagnosticSeverity.Error, true, null, null) diff --git a/vsintegration/src/FSharp.Editor/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/CompletionProvider.fs index 5d23f69d3a5..d7b6cfb860a 100644 --- a/vsintegration/src/FSharp.Editor/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/CompletionProvider.fs @@ -73,11 +73,17 @@ type internal FSharpCompletionProvider(workspace: Workspace, serviceProvider: SV | _ -> true // anything else is a valid classification type static member ProvideCompletionsAsyncAux(sourceText: SourceText, caretPosition: int, options: FSharpProjectOptions, filePath: string, textVersionHash: int) = async { + // REVIEW: ParseFileInProject and CheckFileInProject can cause FSharp.Compiler.Service to become unavailable (i.e. not responding to requests) for + // an arbitrarily long time while they process all files prior to this one in the project (plus dependent projects + // if we enable cross-project checking in multi-project solutions). FCS will not respond to other + // requests unless this task is cancelled. We need to check that this task is cancelled in a timely way by the + // Roslyn UI machinery. let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(filePath, sourceText.ToString(), options) let! checkFileAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) - let checkFileResults = match checkFileAnswer with - | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet" - | FSharpCheckFileAnswer.Succeeded(results) -> results + let checkFileResults = + match checkFileAnswer with + | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet or was cancelled" + | FSharpCheckFileAnswer.Succeeded(results) -> results let textLine = sourceText.Lines.GetLineFromPosition(caretPosition) let textLinePos = sourceText.Lines.GetLinePosition(caretPosition) @@ -110,7 +116,7 @@ type internal FSharpCompletionProvider(workspace: Workspace, serviceProvider: SV FSharpCompletionProvider.ShouldTriggerCompletionAux(sourceText, caretPosition, trigger.Kind, document.FilePath, defines) override this.ProvideCompletionsAsync(context: Microsoft.CodeAnalysis.Completion.CompletionContext) = - let computation = async { + async { match FSharpLanguageService.GetOptions(context.Document.Project.Id) with | Some(options) -> let! sourceText = context.Document.GetTextAsync(context.CancellationToken) |> Async.AwaitTask @@ -118,12 +124,11 @@ type internal FSharpCompletionProvider(workspace: Workspace, serviceProvider: SV let! results = FSharpCompletionProvider.ProvideCompletionsAsyncAux(sourceText, context.Position, options, context.Document.FilePath, textVersion.GetHashCode()) context.AddItems(results) | None -> () - } + } |> CommonRoslynHelpers.StartAsyncUnitAsTask context.CancellationToken - Task.Run(CommonRoslynHelpers.GetTaskAction(computation), context.CancellationToken) override this.GetDescriptionAsync(_: Document, completionItem: CompletionItem, cancellationToken: CancellationToken): Task = - let computation = async { + async { let exists, declarationItem = declarationItemsCache.TryGetValue(completionItem.DisplayText) if exists then let! description = declarationItem.DescriptionTextAsync @@ -131,7 +136,4 @@ type internal FSharpCompletionProvider(workspace: Workspace, serviceProvider: SV return CompletionDescription.FromText(datatipText) else return CompletionDescription.Empty - } - - Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) - .ContinueWith(CommonRoslynHelpers.GetCompletedTaskResult, cancellationToken) \ No newline at end of file + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken diff --git a/vsintegration/src/FSharp.Editor/DocumentDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/DocumentDiagnosticAnalyzer.fs index c599df57638..dbbceb66a8d 100644 --- a/vsintegration/src/FSharp.Editor/DocumentDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/DocumentDiagnosticAnalyzer.fs @@ -24,18 +24,25 @@ open Microsoft.VisualStudio.FSharp.LanguageService type internal FSharpDocumentDiagnosticAnalyzer() = inherit DocumentDiagnosticAnalyzer() - static member GetDiagnostics(filePath: string, sourceText: SourceText, textVersionHash: int, options: FSharpProjectOptions, addSemanticErrors: bool) = - let parseResults = FSharpLanguageService.Checker.ParseFileInProject(filePath, sourceText.ToString(), options) |> Async.RunSynchronously - let errors = + static member GetDiagnostics(filePath: string, sourceText: SourceText, textVersionHash: int, options: FSharpProjectOptions, addSemanticErrors: bool) = async { + // REVIEW: ParseFileInProject and CheckFileInProject can cause FSharp.Compiler.Service to become unavailable (i.e. not responding to requests) for + // an arbitrarily long time while they process all files prior to this one in the project (plus dependent projects + // if we enable cross-project checking in multi-project solutions). FCS will not respond to other + // requests unless this task is cancelled. We need to check that this task is cancelled in a timely way by the + // Roslyn UI machinery. + let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(filePath, sourceText.ToString(), options) + let! errors = async { if addSemanticErrors then - let checkResultsAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) |> Async.RunSynchronously + let! checkResultsAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) match checkResultsAnswer with - | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet" - | FSharpCheckFileAnswer.Succeeded(results) -> results.Errors + | FSharpCheckFileAnswer.Aborted -> return! failwith "Compilation isn't complete yet" + | FSharpCheckFileAnswer.Succeeded(results) -> return results.Errors else - parseResults.Errors + return parseResults.Errors + } - (errors |> Seq.choose(fun (error) -> + let results = + (errors |> Seq.choose(fun (error) -> if error.StartLineAlternate = 0 || error.EndLineAlternate = 0 then // F# error line numbers are one-based. Compiler returns 0 for global errors (reported by ProjectDiagnosticAnalyzer) None @@ -47,33 +54,30 @@ type internal FSharpDocumentDiagnosticAnalyzer() = let correctedTextSpan = if textSpan.End < sourceText.Length then textSpan else TextSpan.FromBounds(sourceText.Length - 1, sourceText.Length) let location = Location.Create(filePath, correctedTextSpan , linePositionSpan) Some(CommonRoslynHelpers.ConvertError(error, location))) - ).ToImmutableArray() + ).ToImmutableArray() + return results + } override this.SupportedDiagnostics with get() = CommonRoslynHelpers.SupportedDiagnostics() override this.AnalyzeSyntaxAsync(document: Document, cancellationToken: CancellationToken): Task> = - let computation = async { + async { match FSharpLanguageService.GetOptions(document.Project.Id) with | Some(options) -> let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask let! textVersion = document.GetTextVersionAsync(cancellationToken) |> Async.AwaitTask - return FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(document.FilePath, sourceText, textVersion.GetHashCode(), options, false) + return! FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(document.FilePath, sourceText, textVersion.GetHashCode(), options, false) | None -> return ImmutableArray.Empty - } - - Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) - .ContinueWith(CommonRoslynHelpers.GetCompletedTaskResult, cancellationToken) + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken): Task> = - let computation = async { + async { match FSharpLanguageService.GetOptions(document.Project.Id) with | Some(options) -> let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask let! textVersion = document.GetTextVersionAsync(cancellationToken) |> Async.AwaitTask - return FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(document.FilePath, sourceText, textVersion.GetHashCode(), options, true) + return! FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(document.FilePath, sourceText, textVersion.GetHashCode(), options, true) | None -> return ImmutableArray.Empty - } + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken - Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) - .ContinueWith(CommonRoslynHelpers.GetCompletedTaskResult, cancellationToken) diff --git a/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs b/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs index 0eaefd94452..165268a6521 100644 --- a/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs +++ b/vsintegration/src/FSharp.Editor/GoToDefinitionService.fs @@ -61,31 +61,33 @@ type internal FSharpGoToDefinitionService [] ([ Seq.tryFind(fun classifiedSpan -> classifiedSpan.TextSpan.Contains(position)) - let processQualifiedIdentifier(qualifiers, islandColumn) = async { - let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(filePath, sourceText.ToString(), options) - let! checkFileAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) - let checkFileResults = match checkFileAnswer with - | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet" - | FSharpCheckFileAnswer.Succeeded(results) -> results - - let! declarations = checkFileResults.GetDeclarationLocationAlternate (fcsTextLineNumber, islandColumn, textLine.ToString(), qualifiers, false) - - return match declarations with - | FSharpFindDeclResult.DeclFound(range) -> Some(range) - | _ -> None - } - - return match classifiedSpanOption with - | Some(classifiedSpan) -> - match classifiedSpan.ClassificationType with - | ClassificationTypeNames.Identifier -> - match QuickParse.GetCompleteIdentifierIsland true (textLine.ToString()) textLineColumn with - | Some(islandIdentifier, islandColumn, isQuoted) -> - let qualifiers = if isQuoted then [islandIdentifier] else islandIdentifier.Split '.' |> Array.toList - processQualifiedIdentifier(qualifiers, islandColumn) |> Async.RunSynchronously - | None -> None - | _ -> None - | None -> None + match classifiedSpanOption with + | Some(classifiedSpan) -> + match classifiedSpan.ClassificationType with + | ClassificationTypeNames.Identifier -> + match QuickParse.GetCompleteIdentifierIsland true (textLine.ToString()) textLineColumn with + | Some(islandIdentifier, islandColumn, isQuoted) -> + let qualifiers = if isQuoted then [islandIdentifier] else islandIdentifier.Split '.' |> Array.toList + // REVIEW: ParseFileInProject and CheckFileInProject can cause FSharp.Compiler.Service to become unavailable (i.e. not responding to requests) for + // an arbitrarily long time while they process all files prior to this one in the project (plus dependent projects + // if we enable cross-project checking in multi-project solutions). FCS will not respond to other + // requests unless this task is cancelled. We need to check that this task is cancelled in a timely way by the + // Roslyn UI machinery. + let! parseResults = FSharpLanguageService.Checker.ParseFileInProject(filePath, sourceText.ToString(), options) + let! checkFileAnswer = FSharpLanguageService.Checker.CheckFileInProject(parseResults, filePath, textVersionHash, sourceText.ToString(), options) + let checkFileResults = + match checkFileAnswer with + | FSharpCheckFileAnswer.Aborted -> failwith "Compilation isn't complete yet" + | FSharpCheckFileAnswer.Succeeded(results) -> results + + let! declarations = checkFileResults.GetDeclarationLocationAlternate (fcsTextLineNumber, islandColumn, textLine.ToString(), qualifiers, false) + + match declarations with + | FSharpFindDeclResult.DeclFound(range) -> return Some(range) + | _ -> return None + | None -> return None + | _ -> return None + | None -> return None } // FSROSLYNTODO: Since we are not integrated with the Roslyn project system yet, the below call @@ -93,7 +95,7 @@ type internal FSharpGoToDefinitionService [] ([() match FSharpLanguageService.GetOptions(document.Project.Id) with | Some(options) -> @@ -104,7 +106,9 @@ type internal FSharpGoToDefinitionService [] ([ - let refDocumentIds = document.Project.Solution.GetDocumentIdsWithFilePath(range.FileName) + // REVIEW: + let fileName = try System.IO.Path.GetFullPath(range.FileName) with _ -> range.FileName + let refDocumentIds = document.Project.Solution.GetDocumentIdsWithFilePath(fileName) if not refDocumentIds.IsEmpty then let refDocumentId = refDocumentIds.First() let refDocument = document.Project.Solution.GetDocument(refDocumentId) @@ -115,10 +119,7 @@ type internal FSharpGoToDefinitionService [] ([ () | None -> () return results.AsEnumerable() - } - - Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) - .ContinueWith(CommonRoslynHelpers.GetCompletedTaskResult, cancellationToken) + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken interface IGoToDefinitionService with member this.FindDefinitionsAsync(document: Document, position: int, cancellationToken: CancellationToken) = @@ -126,6 +127,8 @@ type internal FSharpGoToDefinitionService [] ([) member this.GetDataTipInfoAsync(document: Document, position: int, cancellationToken: CancellationToken): Task = - let computation = async { + async { match FSharpLanguageService.GetOptions(document.Project.Id) with | Some(options) -> let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, options.OtherOptions |> Seq.toList) @@ -75,9 +75,6 @@ type internal FSharpLanguageDebugInfoService() = | None -> Unchecked.defaultof | Some(textSpan) -> new DebugDataTipInfo(textSpan, sourceText.GetSubText(textSpan).ToString()) | None -> return Unchecked.defaultof - } - - Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) - .ContinueWith(CommonRoslynHelpers.GetCompletedTaskResult, cancellationToken) + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService.fs index aa1aac86c12..9a0d7728ab4 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService.fs @@ -86,14 +86,13 @@ type internal FSharpLanguageService(package : FSharpPackage) = let filename = VsTextLines.GetFilename textLines match VsRunningDocumentTable.FindDocumentWithoutLocking(package.RunningDocumentTable,filename) with | Some (hier, _) -> - if IsScript(filename) then + match hier with + | :? IProvideProjectSite as siteProvider when not (IsScript(filename)) -> + this.SetupProjectFile(siteProvider, workspace) + | _ -> let editorAdapterFactoryService = this.Package.ComponentModel.GetService() let fileContents = VsTextLines.GetFileContents(textLines, editorAdapterFactoryService) this.SetupStandAloneFile(filename, fileContents, workspace, hier) - else - match hier with - | :? IProvideProjectSite as siteProvider -> this.SetupProjectFile(siteProvider, workspace) - | _ -> () | _ -> () | _ -> () diff --git a/vsintegration/src/FSharp.Editor/ProjectDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/ProjectDiagnosticAnalyzer.fs index f80b6944b36..493ed4fc7f6 100644 --- a/vsintegration/src/FSharp.Editor/ProjectDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/ProjectDiagnosticAnalyzer.fs @@ -25,25 +25,24 @@ open Microsoft.VisualStudio.FSharp.LanguageService type internal FSharpProjectDiagnosticAnalyzer() = inherit ProjectDiagnosticAnalyzer() - static member GetDiagnostics(options: FSharpProjectOptions) = - let checkProjectResults = FSharpLanguageService.Checker.ParseAndCheckProject(options) |> Async.RunSynchronously - (checkProjectResults.Errors |> Seq.choose(fun (error) -> + static member GetDiagnostics(options: FSharpProjectOptions) = async { + let! checkProjectResults = FSharpLanguageService.Checker.ParseAndCheckProject(options) + let results = + (checkProjectResults.Errors |> Seq.choose(fun (error) -> if error.StartLineAlternate = 0 || error.EndLineAlternate = 0 then Some(CommonRoslynHelpers.ConvertError(error, Location.None)) else // F# error line numbers are one-based. Errors that have a valid line number are reported by DocumentDiagnosticAnalyzer None - )).ToImmutableArray() + )).ToImmutableArray() + return results + } override this.SupportedDiagnostics with get() = CommonRoslynHelpers.SupportedDiagnostics() override this.AnalyzeProjectAsync(project: Project, cancellationToken: CancellationToken): Task> = - let computation = async { + async { match FSharpLanguageService.GetOptions(project.Id) with - | Some(options) -> - return FSharpProjectDiagnosticAnalyzer.GetDiagnostics(options) + | Some(options) -> return! FSharpProjectDiagnosticAnalyzer.GetDiagnostics(options) | None -> return ImmutableArray.Empty - } - - Async.StartAsTask(computation, TaskCreationOptions.None, cancellationToken) - .ContinueWith(CommonRoslynHelpers.GetCompletedTaskResult, cancellationToken) + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken diff --git a/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs b/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs index 77b8146d992..82dc1cb1d37 100644 --- a/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs +++ b/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs @@ -169,15 +169,9 @@ type internal FSharpLanguageServiceBackgroundRequests // Should never matter but don't let anything in FSharp.Compiler extend the lifetime of 'source' let sr = ref (Some source) - // Determine whether to abandon the CheckFileIfReady operation - let isResultObsolete() = - match !sr with - | None -> false - | Some source -> req.Timestamp <> source.ChangeCount - // Type-checking let typedResults,aborted = - match interactiveChecker.CheckFileInProjectIfReady(parseResults,req.FileName,req.Timestamp,req.Text,checkOptions,IsResultObsolete(isResultObsolete),req.Snapshot) |> Async.RunSynchronously with + match interactiveChecker.CheckFileInProjectIfReady(parseResults,req.FileName,req.Timestamp,req.Text,checkOptions,req.Snapshot) |> Async.RunSynchronously with | None -> None,false | Some FSharpCheckFileAnswer.Aborted -> // isResultObsolete returned true during the type check. diff --git a/vsintegration/tests/unittests/DocumentDiagnosticAnalyzerTests.fs b/vsintegration/tests/unittests/DocumentDiagnosticAnalyzerTests.fs index 165a5c88cb5..f0c6eed2883 100644 --- a/vsintegration/tests/unittests/DocumentDiagnosticAnalyzerTests.fs +++ b/vsintegration/tests/unittests/DocumentDiagnosticAnalyzerTests.fs @@ -38,12 +38,14 @@ type DocumentDiagnosticAnalyzerTests() = | None -> options | Some(flags) -> {options with OtherOptions = Array.append options.OtherOptions flags} - let errors = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(filePath, SourceText.From(fileContents), 0, additionalOptions, true) + let errors = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(filePath, SourceText.From(fileContents), 0, additionalOptions, true) |> Async.RunSynchronously Assert.AreEqual(0, errors.Length, "There should be no errors generated") member private this.VerifyErrorAtMarker(fileContents: string, expectedMarker: string, ?expectedMessage: string) = - let errors = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(filePath, SourceText.From(fileContents), 0, options, true) |> - Seq.filter(fun e -> e.Severity = DiagnosticSeverity.Error) |> Seq.toArray + let errors = + FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(filePath, SourceText.From(fileContents), 0, options, true) + |> Async.RunSynchronously + |> Seq.filter(fun e -> e.Severity = DiagnosticSeverity.Error) |> Seq.toArray Assert.AreEqual(1, errors.Length, "There should be exactly one error generated") let actualError = errors.[0] if expectedMessage.IsSome then @@ -55,8 +57,10 @@ type DocumentDiagnosticAnalyzerTests() = Assert.AreEqual(expectedEnd, actualError.Location.SourceSpan.End, "Error end positions should match") member private this.VerifyDiagnosticBetweenMarkers(fileContents: string, expectedMessage: string, expectedSeverity: DiagnosticSeverity) = - let errors = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(filePath, SourceText.From(fileContents), 0, options, true) |> - Seq.filter(fun e -> e.Severity = expectedSeverity) |> Seq.toArray + let errors = + FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(filePath, SourceText.From(fileContents), 0, options, true) + |> Async.RunSynchronously + |> Seq.filter(fun e -> e.Severity = expectedSeverity) |> Seq.toArray Assert.AreEqual(1, errors.Length, "There should be exactly one error generated") let actualError = errors.[0] Assert.AreEqual(expectedSeverity, actualError.Severity) diff --git a/vsintegration/tests/unittests/ProjectDiagnosticAnalyzerTests.fs b/vsintegration/tests/unittests/ProjectDiagnosticAnalyzerTests.fs index 7753c6d1c5a..183ae2e778d 100644 --- a/vsintegration/tests/unittests/ProjectDiagnosticAnalyzerTests.fs +++ b/vsintegration/tests/unittests/ProjectDiagnosticAnalyzerTests.fs @@ -43,7 +43,7 @@ printf "%d" x let options = CreateProjectAndGetOptions(fileContents) let additionalOptions = {options with OtherOptions = Array.append options.OtherOptions [| "--times" |]} - let errors = FSharpProjectDiagnosticAnalyzer.GetDiagnostics(additionalOptions) + let errors = FSharpProjectDiagnosticAnalyzer.GetDiagnostics(additionalOptions) |> Async.RunSynchronously Assert.AreEqual(1, errors.Length, "Exactly one warning should have been reported") let warning = errors.[0] @@ -59,5 +59,5 @@ printf "%d" x """ let options = CreateProjectAndGetOptions(fileContents) - let errors = FSharpProjectDiagnosticAnalyzer.GetDiagnostics(options) + let errors = FSharpProjectDiagnosticAnalyzer.GetDiagnostics(options) |> Async.RunSynchronously Assert.AreEqual(0, errors.Length, "No semantic errors should have been reported") diff --git a/vsintegration/tests/unittests/Tests.LanguageService.IncrementalBuild.fs b/vsintegration/tests/unittests/Tests.LanguageService.IncrementalBuild.fs index 41725a204fd..fb470bca9ff 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.IncrementalBuild.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.IncrementalBuild.fs @@ -4,6 +4,8 @@ namespace Tests.LanguageService open System open System.IO +open System.Threading +open System.Threading.Tasks open NUnit.Framework #if NUNIT_V2 #else @@ -29,6 +31,8 @@ module internal Vector = [] type IncrementalBuild() = + let save _ = () + let ct = CancellationToken.None /// Called per test [] @@ -71,7 +75,7 @@ type IncrementalBuild() = let bound = buildDesc.GetInitialPartialBuild inputs let DoCertainStep bound = - match IncrementalBuild.Step (Target(mapped,None)) bound with + match IncrementalBuild.Step save ct (Target(mapped,None)) bound with | Some bound -> bound | None -> failwith "Expected to be able to step" @@ -87,7 +91,7 @@ type IncrementalBuild() = updateStamp:=false bound <- DoCertainStep bound bound <- DoCertainStep bound - match IncrementalBuild.Step (Target (mapped, None)) bound with + match IncrementalBuild.Step save ct (Target (mapped, None)) bound with | Some bound -> failwith "Build should have stopped" | None -> () @@ -117,14 +121,14 @@ type IncrementalBuild() = printf "-[Step1]----------------------------------------------------------------------------------------\n" // Evaluate the first time. - let bound = Eval scanned bound + let bound = Eval save ct scanned bound let r = GetVectorResult (scanned, bound) Assert.AreEqual("AccVal-File1.fs-Suffix1-File2.fs-Suffix1",r.[1]) printf "-[Step2]----------------------------------------------------------------------------------------\n" // Evaluate the second time. No change should be seen. mapSuffix:="Suffix2" - let bound = Eval scanned bound + let bound = Eval save ct scanned bound let r = GetVectorResult (scanned,bound) Assert.AreEqual("AccVal-File1.fs-Suffix1-File2.fs-Suffix1",r.[1]) @@ -132,7 +136,7 @@ type IncrementalBuild() = // Evaluate a third time with timestamps updated. Should cause a rebuild System.Threading.Thread.Sleep 10 // Sleep a little to avoid grabbing the same 'Now' stampAs:=DateTime.Now - let bound = Eval scanned bound + let bound = Eval save ct scanned bound let r = GetVectorResult (scanned,bound) Assert.AreEqual("AccVal-File1.fs-Suffix2-File2.fs-Suffix2",r.[1]) @@ -158,7 +162,7 @@ type IncrementalBuild() = let inputs1 = [ BuildInput.VectorInput(inputVector, [""]) ] let build1 = buildDesc.GetInitialPartialBuild inputs1 - let build1Evaled = Eval result build1 + let build1Evaled = Eval save ct result build1 let r1 = GetScalarResult (result, build1Evaled) match r1 with | Some(v,dt) -> Assert.AreEqual(1,v) @@ -169,7 +173,7 @@ type IncrementalBuild() = let inputs0 = [ BuildInput.VectorInput(inputVector, []) ] let build0 = buildDesc.GetInitialPartialBuild inputs0 - let build0Evaled = Eval result build0 + let build0Evaled = Eval save ct result build0 let r0 = GetScalarResult (result, build0Evaled) match r0 with | Some(v,dt) -> Assert.AreEqual(0,v) @@ -205,7 +209,7 @@ type IncrementalBuild() = // Evaluate it with value 1 elements := 1 - let bound = Eval result bound + let bound = Eval save ct result bound let r1 = GetScalarResult(result, bound) match r1 with | Some(s,dt) -> printfn "%s" s @@ -216,7 +220,7 @@ type IncrementalBuild() = System.Threading.Thread.Sleep(100) timestamp := System.DateTime.Now - let bound = Eval result bound + let bound = Eval save ct result bound let r2 = GetScalarResult (result, bound) match r2 with | Some(s,dt) -> Assert.AreEqual("Mapped Input 0 ",s) @@ -322,14 +326,14 @@ type IncrementalBuild() = printf "-[Step1]----------------------------------------------------------------------------------------\n" // Evaluate the first time. - let bound = Eval mapped bound + let bound = Eval save ct mapped bound let r = GetVectorResult (mapped,bound) Assert.AreEqual("File2.fs.Suffix1",r.[1]) printf "-[Step2]----------------------------------------------------------------------------------------\n" // Evaluate the second time. No change should be seen. mapSuffix:="Suffix2" - let bound = Eval mapped bound + let bound = Eval save ct mapped bound let r = GetVectorResult (mapped,bound) Assert.AreEqual("File2.fs.Suffix1",r.[1]) @@ -338,7 +342,7 @@ type IncrementalBuild() = while !stampAs = DateTime.Now do System.Threading.Thread.Sleep 10 // Sleep a little to avoid grabbing the same 'Now' stampAs:=DateTime.Now - let bound = Eval mapped bound + let bound = Eval save ct mapped bound let r = GetVectorResult (mapped,bound) Assert.AreEqual("File2.fs.Suffix2",r.[1]) @@ -364,14 +368,14 @@ type IncrementalBuild() = printf "-[Step1]----------------------------------------------------------------------------------------\n" // Evaluate the first time. - let bound = Eval joined bound + let bound = Eval save ct joined bound let (r,_) = Option.get (GetScalarResult(joined,bound)) Assert.AreEqual("Join1",r) printf "-[Step2]----------------------------------------------------------------------------------------\n" // Evaluate the second time. No change should be seen. joinedResult:="Join2" - let bound = Eval joined bound + let bound = Eval save ct joined bound let (r,_) = Option.get (GetScalarResult (joined,bound)) Assert.AreEqual("Join1",r) @@ -380,7 +384,7 @@ type IncrementalBuild() = while !stampAs = DateTime.Now do System.Threading.Thread.Sleep 10 // Sleep a little to avoid grabbing the same 'Now' stampAs:=DateTime.Now - let bound = Eval joined bound + let bound = Eval save ct joined bound let (r,_) = Option.get (GetScalarResult (joined,bound)) Assert.AreEqual("Join2",r) @@ -399,7 +403,7 @@ type IncrementalBuild() = let inputs = [ BuildInput.VectorInput(inVector, ["File1.fs";"File2.fs";"File3.fs"]) ] let bound = buildDesc.GetInitialPartialBuild inputs - let e = Eval scanned bound + let e = Eval save ct scanned bound let r = GetScalarResult (vectorSize,e) match r with | Some(r,_) -> Assert.AreEqual(3,r) @@ -453,7 +457,7 @@ type IncrementalBuild() = let inputs = [ BuildInput.ScalarInput(inScalar, "A Scalar Value") ] let bound = buildDesc.GetInitialPartialBuild inputs - let e = Eval inScalar bound + let e = Eval save ct inScalar bound let r = GetScalarResult(inScalar,e) match r with | Some(r,_) -> Assert.AreEqual("A Scalar Value", r) @@ -476,7 +480,7 @@ type IncrementalBuild() = BuildInput.ScalarInput(inScalar, (5,"")) ] let bound = buildDesc.GetInitialPartialBuild(inputs) - let e = Eval result bound + let e = Eval save ct result bound let r = GetVectorResult(result,e) if [| (6,"File1.fs"); (7,"File2.fs"); (8, "File3.fs") |] <> r then printfn "Got %A" r @@ -493,7 +497,7 @@ type IncrementalBuild() = let inputs = [ BuildInput.VectorInput(inVector, ["File1.fs";"File2.fs";"File3.fs"]) ] let bound = buildDesc.GetInitialPartialBuild(inputs) - let e = Eval result bound + let e = Eval save ct result bound let r = GetScalarResult (result, e) match r with | Some(r,ts)-> @@ -504,6 +508,22 @@ type IncrementalBuild() = + /// Check a cancellation + [] + member public rb.``Can cancel Eval``() = + let buildDesc = new BuildDescriptionScope() + let inVector = InputVector "InputVector" + let result = Vector.ToScalar "ToScalar" inVector + buildDesc.DeclareScalarOutput result + let inputs = [ BuildInput.VectorInput(inVector, ["File1.fs";"File2.fs";"File3.fs"]) ] + let bound = buildDesc.GetInitialPartialBuild(inputs) + + let cts = new CancellationTokenSource() + cts.Cancel() + let res = try Eval save cts.Token result bound |> ignore; false with :? OperationCanceledException -> true + Assert.AreEqual(res, true) + + /// This test replicates the data flow of the assembly reference model. It includes several concepts /// that were new at the time: Scalars, Invalidation, Disposal [] @@ -549,7 +569,7 @@ type IncrementalBuild() = [ BuildInput.VectorInput(fileNamesNode, ["File1.fs";"File2.fs";"File3.fs"]); BuildInput.VectorInput(referencedAssembliesNode, [("lib1.dll", now);("lib2.dll", now)]) ] let bound = buildDesc.GetInitialPartialBuild(inputs) - let e = Eval finalizedTypeCheckNode bound + let e = Eval save ct finalizedTypeCheckNode bound let r = GetScalarResult(finalizedTypeCheckNode,e) () @@ -566,7 +586,7 @@ type IncrementalBuild() = let inputs = [ BuildInput.VectorInput(inputs, [1;2;3;4]) ] let bound = buildDesc.GetInitialPartialBuild inputs - let evaled = Eval outputs bound + let evaled = Eval save ct outputs bound let outputs = GetVectorResult(outputs,evaled) Assert.AreEqual("Transformation of 4", outputs.[3]) () @@ -591,7 +611,7 @@ type IncrementalBuild() = let inputs = [ BuildInput.VectorInput(inputs, [1;2;3;4]) ] let bound = buildDesc.GetInitialPartialBuild inputs - let evaled = Eval outputs bound + let evaled = Eval save ct outputs bound let outputs = GetVectorResult(outputs,evaled) Assert.AreEqual("Transformation of 4", outputs.[3]) () @@ -609,7 +629,7 @@ type IncrementalBuild() = let inputs = [ BuildInput.VectorInput(inputs, []) ] let bound = buildDesc.GetInitialPartialBuild inputs - let evaled = Eval outputs bound + let evaled = Eval save ct outputs bound let outputs = GetVectorResult(outputs,evaled) ()