diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 3ca4f8a248f..65795156fc9 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -2354,11 +2354,88 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let scriptClosureCacheLock = Lock() let frameworkTcImportsCache = FrameworkImportsCache(frameworkTcImportsCacheStrongSize) + let parseCacheLock = Lock() + + + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.parseFileInProjectCache. Most recently used cache for parsing files. + let parseFileCache = MruCache(parseFileCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) + + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCachePossiblyStale + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCache + // + /// Cache which holds recently seen type-checks. + /// This cache may hold out-of-date entries, in two senses + /// - there may be a more recent antecedent state available because the background build has made it available + /// - the source for the file may have changed + + let checkFileInProjectCachePossiblyStale = + MruCache + (keepStrongly=checkFileInProjectCacheSize, + areSame=AreSameForChecking2, + areSimilar=AreSubsumable2) + + // Also keyed on source. This can only be out of date if the antecedent is out of date + let checkFileInProjectCache = + MruCache + (keepStrongly=checkFileInProjectCacheSize, + areSame=AreSameForChecking3, + areSimilar=AreSubsumable3) + + /// Holds keys for files being currently checked. It's used to prevent checking same file in parallel (interleaving chunck queued to Reactor). + let beingCheckedFileTable = + ConcurrentDictionary + (HashIdentity.FromFunctions + hash + (fun (f1, o1, v1) (f2, o2, v2) -> f1 = f2 && v1 = v2 && FSharpProjectOptions.AreSameForChecking(o1, o2))) + + let clearProjectFilesCache ltok (options: FSharpProjectOptions) = + options.SourceFiles + |> Array.iter (fun filename -> + checkFileInProjectCachePossiblyStale.RemoveAnySimilar(ltok, (filename, options)) + checkFileInProjectCache.RemoveAnySimilar(ltok, (filename, 0, options)) + ) + + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.backgroundCompiler.incrementalBuildersCache. This root typically holds more + // live information than anything else in the F# Language Service, since it holds up to 3 (projectCacheStrongSize) background project builds + // strongly. + // + /// Cache of builds keyed by options. + let incrementalBuildersCache = + MruCache + (keepStrongly=projectCacheSize, keepMax=projectCacheSize, + areSame = FSharpProjectOptions.AreSameForChecking, + areSimilar = FSharpProjectOptions.UseSameProject, + requiredToKeep=(fun (builderOpt,_,_) -> match builderOpt with None -> false | Some (b:IncrementalBuilder) -> b.IsBeingKeptAliveApartFromCacheEntry), + onDiscard = (fun (_, _, decrement:IDisposable) -> decrement.Dispose())) + + let invalidateProject ctok options = + incrementalBuildersCache.RemoveAnySimilar (ctok, options) + parseCacheLock.AcquireLock (fun ltok -> clearProjectFilesCache ltok options) + /// CreateOneIncrementalBuilder (for background type checking). Note that fsc.fs also /// creates an incremental builder used by the command line compiler. - let CreateOneIncrementalBuilder (ctok, options:FSharpProjectOptions, userOpName) = + let rec CreateOneIncrementalBuilder (ctok, options:FSharpProjectOptions, userOpName) : Cancellable<(IncrementalBuilder option * FSharpErrorInfo [] * IDisposable)> = cancellable { Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CreateOneIncrementalBuilder", options.ProjectFileName) + + // When we creating a new incremental builder, it's going to invalidate everything in the cache. + // Therefore, let's invalidate everything. + invalidateProject ctok options + System.Diagnostics.Debug.WriteLine(sprintf "%A %A" options.ProjectFileName options.Stamp) + let! ct = Cancellable.token () + + let mutable didCancel = false + options.ReferencedProjects + |> Seq.iter (fun (_, referencedOptions) -> + match getOrCreateBuilderAndKeepAlive (ctok, referencedOptions, userOpName) |> Cancellable.run ct with + | ValueOrCancelled.Value (_, _, decrement: IDisposable) -> decrement.Dispose () + | _ -> didCancel <- true + ) + + if didCancel then + return! Cancellable.canceled () + else + let projectReferences = [ for (nm,opts) in options.ReferencedProjects do @@ -2372,12 +2449,20 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC { new IProjectReference with member x.EvaluateRawContents(ctok) = cancellable { - Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "ParseAndCheckProjectImpl", nm) - let! r = self.ParseAndCheckProjectImpl(opts, ctok, userOpName + ".CheckReferencedProject("+nm+")") - return r.RawFSharpAssemblyData + match incrementalBuildersCache.TryGet (ctok, opts) with + | Some _ -> + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "ParseAndCheckProjectImpl", nm) + let! r = self.ParseAndCheckProjectImpl(opts, ctok, userOpName + ".CheckReferencedProject("+nm+")") + return r.RawFSharpAssemblyData + | _ -> + return None } member x.TryGetLogicalTimeStamp(cache, ctok) = - self.TryGetLogicalTimeStampForProject(cache, ctok, opts, userOpName + ".TimeStampReferencedProject("+nm+")") + match incrementalBuildersCache.TryGet (ctok, opts) with + | Some _ -> + self.TryGetLogicalTimeStampForProject(cache, ctok, opts, userOpName + ".TimeStampReferencedProject("+nm+")") + | _ -> + None member x.FileName = nm } ] let loadClosure = scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.TryGet (ltok, options)) @@ -2413,20 +2498,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC return (builderOpt, diagnostics, decrement) } - // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.backgroundCompiler.incrementalBuildersCache. This root typically holds more - // live information than anything else in the F# Language Service, since it holds up to 3 (projectCacheStrongSize) background project builds - // strongly. - // - /// Cache of builds keyed by options. - let incrementalBuildersCache = - MruCache - (keepStrongly=projectCacheSize, keepMax=projectCacheSize, - areSame = FSharpProjectOptions.AreSameForChecking, - areSimilar = FSharpProjectOptions.UseSameProject, - requiredToKeep=(fun (builderOpt,_,_) -> match builderOpt with None -> false | Some (b:IncrementalBuilder) -> b.IsBeingKeptAliveApartFromCacheEntry), - onDiscard = (fun (_, _, decrement:IDisposable) -> decrement.Dispose())) - - let getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) = + and getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) = cancellable { RequireCompilationThread ctok match incrementalBuildersCache.TryGet (ctok, options) with @@ -2442,40 +2514,6 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC return builderOpt, creationErrors, decrement } - let parseCacheLock = Lock() - - - // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.parseFileInProjectCache. Most recently used cache for parsing files. - let parseFileCache = MruCache(parseFileCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) - - // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCachePossiblyStale - // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCache - // - /// Cache which holds recently seen type-checks. - /// This cache may hold out-of-date entries, in two senses - /// - there may be a more recent antecedent state available because the background build has made it available - /// - the source for the file may have changed - - let checkFileInProjectCachePossiblyStale = - MruCache - (keepStrongly=checkFileInProjectCacheSize, - areSame=AreSameForChecking2, - areSimilar=AreSubsumable2) - - // Also keyed on source. This can only be out of date if the antecedent is out of date - let checkFileInProjectCache = - MruCache - (keepStrongly=checkFileInProjectCacheSize, - areSame=AreSameForChecking3, - areSimilar=AreSubsumable3) - - /// Holds keys for files being currently checked. It's used to prevent checking same file in parallel (interleaving chunck queued to Reactor). - let beingCheckedFileTable = - ConcurrentDictionary - (HashIdentity.FromFunctions - hash - (fun (f1, o1, v1) (f2, o2, v2) -> f1 = f2 && v1 = v2 && FSharpProjectOptions.AreSameForChecking(o1, o2))) - static let mutable foregroundParseCount = 0 static let mutable foregroundTypeCheckCount = 0 @@ -2498,6 +2536,22 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC | Parser.TypeCheckAborted.Yes -> FSharpCheckFileAnswer.Aborted | Parser.TypeCheckAborted.No scope -> FSharpCheckFileAnswer.Succeeded(MakeCheckFileResults(filename, options, builder, scope, dependencyFiles, creationErrors, parseErrors, tcErrors)) + /// For testing purposes, not for public consumption. + /// Tries to find if the given project exists in any kind of cache, whether it be incremental builder, check file, check file stale cache. + member bc.ProjectExistsInAnyCache (options: FSharpProjectOptions, userOpName) = + reactor.EnqueueAndAwaitOpAsync(userOpName, "ProjectExistsInAnyCache", options.ProjectFileName, fun ctok -> + let exists = + incrementalBuildersCache.ContainsSimilarKey (ctok, options) || + parseCacheLock.AcquireLock (fun ltok -> + options.SourceFiles + |> Array.exists (fun filename -> + checkFileInProjectCachePossiblyStale.ContainsSimilarKey(ltok, (filename, options)) || + checkFileInProjectCache.ContainsSimilarKey(ltok, (filename, 0, options)) + ) + ) + cancellable.Return exists + ) + member bc.RecordTypeCheckFileInProjectResults(filename,options,parsingOptions,parseResults,fileVersion,priorTimeStamp,checkAnswer,sourceText) = match checkAnswer with | None @@ -2886,7 +2940,6 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC // If there was a similar entry then re-establish an empty builder . This is a somewhat arbitrary choice - it // will have the effect of releasing memory associated with the previous builder, but costs some time. if incrementalBuildersCache.ContainsSimilarKey (ctok, options) then - // 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 incrementalBuildersCache.Set. let newBuilderInfo = CreateOneIncrementalBuilder (ctok, options, userOpName) |> Cancellable.runWithoutCancellation @@ -2896,6 +2949,10 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC if startBackgroundCompileIfAlreadySeen then bc.CheckProjectInBackground(options, userOpName + ".StartBackgroundCompile")) + member bc.InvalidateProject(options: FSharpProjectOptions, userOpName) = + reactor.EnqueueOp(userOpName, "InvalidateProject: Stamp(" + (options.Stamp |> Option.defaultValue 0L).ToString() + ")", options.ProjectFileName, fun ctok -> + invalidateProject ctok options) + member bc.NotifyProjectCleaned (options : FSharpProjectOptions, userOpName) = reactor.EnqueueAndAwaitOpAsync(userOpName, "NotifyProjectCleaned", options.ProjectFileName, fun ctok -> cancellable { @@ -2951,6 +3008,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC incrementalBuildersCache.Clear ctok frameworkTcImportsCache.Clear ctok scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.Clear ltok) + ILBinaryReader.ClearAllILModuleReaderCache () cancellable.Return ()) member bc.DownsizeCaches(userOpName) = @@ -3011,6 +3069,12 @@ type FSharpChecker(legacyReferenceResolver, projectCacheSize, keepAssemblyConten member ic.ReferenceResolver = legacyReferenceResolver + /// For testing purposes, not for public consumption. + /// Tries to find if the given project exists in any kind of cache, whether it be incremental builder, check file, check file stale cache. + member ic.ProjectExistsInAnyCache (options, ?userOpName) = + let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.ProjectExistsInAnyCache (options, userOpName) + member ic.MatchBraces(filename, sourceText: ISourceText, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" let hash = sourceText.GetHashCode() @@ -3175,6 +3239,11 @@ type FSharpChecker(legacyReferenceResolver, projectCacheSize, keepAssemblyConten let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.InvalidateConfiguration(options, startBackgroundCompile, userOpName) + /// Invalidate a project. Clears all caches related to this the project represented by the given FSharpProjectOptions, including check files, stale check files, etc. + member ic.InvalidateProject(options, ?userOpName: string) = + let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.InvalidateProject(options, userOpName) + /// This function is called when a project has been cleaned, and thus type providers should be refreshed. member ic.NotifyProjectCleaned(options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index a17abb46a3d..dfaa1cdcd9b 100755 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -374,6 +374,10 @@ type public FSharpChecker = /// An optional resolver to access the contents of .NET binaries in a memory-efficient way static member Create : ?projectCacheSize: int * ?keepAssemblyContents: bool * ?keepAllBackgroundResolutions: bool * ?legacyReferenceResolver: ReferenceResolver.Resolver * ?tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot * ?suggestNamesForErrors: bool -> FSharpChecker + /// For testing purposes, not for public consumption. + /// Tries to find if the given project exists in any kind of cache, whether it be incremental builder, check file, check file stale cache. + member internal ProjectExistsInAnyCache: options: FSharpProjectOptions * ?userOpName: string -> Async + /// /// Parse a source code file, returning information about brace matching in the file. /// Return an enumeration of the matching parenthetical tokens in the file. @@ -633,7 +637,12 @@ type public FSharpChecker = /// For example, dependent references may have been deleted or created. /// Start a background compile of the project if a project with the same name has already been seen before. /// An optional string used for tracing compiler operations associated with this request. - member InvalidateConfiguration: options: FSharpProjectOptions * ?startBackgroundCompileIfAlreadySeen: bool * ?userOpName: string -> unit + member InvalidateConfiguration: options: FSharpProjectOptions * ?startBackgroundCompileIfAlreadySeen: bool * ?userOpName: string -> unit + + /// Invalidate a project. Clears all caches related to this the project represented by the given FSharpProjectOptions, including check files, stale check files, etc. + /// The options for the project or script, used to determine active --define conditionals and other options relevant to parsing. + /// An optional string used for tracing compiler operations associated with this request. + member InvalidateProject: options: FSharpProjectOptions * ?userOpName: string -> unit /// Set the project to be checked in the background. Overrides any previous call to CheckProjectInBackground member CheckProjectInBackground: options: FSharpProjectOptions * ?userOpName: string -> unit diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs index 288f2a4dca1..980f6b37747 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs @@ -3,6 +3,7 @@ namespace Microsoft.VisualStudio.FSharp.Editor open System +open System.Diagnostics open System.Collections.Generic open System.Collections.Concurrent open System.Collections.Immutable @@ -24,145 +25,190 @@ open Microsoft.VisualStudio.LanguageServices.Implementation.TaskList [] module private FSharpProjectOptionsHelpers = - let mapCpsProjectToSite(workspace:VisualStudioWorkspaceImpl, project:Project, serviceProvider:System.IServiceProvider, cpsCommandLineOptions: IDictionary) = - let hier = workspace.GetHierarchy(project.Id) + let mapCpsProjectToSite(project:Project, cpsCommandLineOptions: IDictionary) = let sourcePaths, referencePaths, options = match cpsCommandLineOptions.TryGetValue(project.Id) with | true, (sourcePaths, options) -> sourcePaths, [||], options | false, _ -> [||], [||], [||] - { - new IProvideProjectSite with - member x.GetProjectSite() = - let mutable errorReporter = - let reporter = ProjectExternalErrorReporter(project.Id, "FS", serviceProvider) - Some(reporter:> IVsLanguageServiceBuildErrorReporter2) + let mutable errorReporter = Unchecked.defaultof<_> // we don't use this - { - new IProjectSite with - member __.Description = project.Name - member __.CompilationSourceFiles = sourcePaths - member __.CompilationOptions = - Array.concat [options; referencePaths |> Array.map(fun r -> "-r:" + r)] - member __.CompilationReferences = referencePaths - member site.CompilationBinOutputPath = site.CompilationOptions |> Array.tryPick (fun s -> if s.StartsWith("-o:") then Some s.[3..] else None) - member __.ProjectFileName = project.FilePath - member __.AdviseProjectSiteChanges(_,_) = () - member __.AdviseProjectSiteCleaned(_,_) = () - member __.AdviseProjectSiteClosed(_,_) = () - member __.IsIncompleteTypeCheckEnvironment = false - member __.TargetFrameworkMoniker = "" - member __.ProjectGuid = project.Id.Id.ToString() - member __.LoadTime = System.DateTime.Now - member __.ProjectProvider = Some (x) - member __.BuildErrorReporter with get () = errorReporter and set (v) = errorReporter <- v - } - interface IVsHierarchy with - member __.SetSite(psp) = hier.SetSite(psp) - member __.GetSite(psp) = hier.GetSite(ref psp) - member __.QueryClose(pfCanClose)= hier.QueryClose(ref pfCanClose) - member __.Close() = hier.Close() - member __.GetGuidProperty(itemid, propid, pguid) = hier.GetGuidProperty(itemid, propid, ref pguid) - member __.SetGuidProperty(itemid, propid, rguid) = hier.SetGuidProperty(itemid, propid, ref rguid) - member __.GetProperty(itemid, propid, pvar) = hier.GetProperty(itemid, propid, ref pvar) - member __.SetProperty(itemid, propid, var) = hier.SetProperty(itemid, propid, var) - member __.GetNestedHierarchy(itemid, iidHierarchyNested, ppHierarchyNested, pitemidNested) = - hier.GetNestedHierarchy(itemid, ref iidHierarchyNested, ref ppHierarchyNested, ref pitemidNested) - member __.GetCanonicalName(itemid, pbstrName) = hier.GetCanonicalName(itemid, ref pbstrName) - member __.ParseCanonicalName(pszName, pitemid) = hier.ParseCanonicalName(pszName, ref pitemid) - member __.Unused0() = hier.Unused0() - member __.AdviseHierarchyEvents(pEventSink, pdwCookie) = hier.AdviseHierarchyEvents(pEventSink, ref pdwCookie) - member __.UnadviseHierarchyEvents(dwCookie) = hier.UnadviseHierarchyEvents(dwCookie) - member __.Unused1() = hier.Unused1() - member __.Unused2() = hier.Unused2() - member __.Unused3() = hier.Unused3() - member __.Unused4() = hier.Unused4() + { + new IProjectSite with + member __.Description = project.Name + member __.CompilationSourceFiles = sourcePaths + member __.CompilationOptions = + Array.concat [options; referencePaths |> Array.map(fun r -> "-r:" + r)] + member __.CompilationReferences = referencePaths + member site.CompilationBinOutputPath = site.CompilationOptions |> Array.tryPick (fun s -> if s.StartsWith("-o:") then Some s.[3..] else None) + member __.ProjectFileName = project.FilePath + member __.AdviseProjectSiteChanges(_,_) = () + member __.AdviseProjectSiteCleaned(_,_) = () + member __.AdviseProjectSiteClosed(_,_) = () + member __.IsIncompleteTypeCheckEnvironment = false + member __.TargetFrameworkMoniker = "" + member __.ProjectGuid = project.Id.Id.ToString() + member __.LoadTime = System.DateTime.Now + member __.ProjectProvider = None + member __.BuildErrorReporter with get () = errorReporter and set (v) = errorReporter <- v } - let hasProjectVersionChanged (oldProject: Project) (newProject: Project) = - oldProject.Version <> newProject.Version - - let hasDependentVersionChanged (oldProject: Project) (newProject: Project) = - let oldProjectRefs = oldProject.ProjectReferences - let newProjectRefs = newProject.ProjectReferences - oldProjectRefs.Count() <> newProjectRefs.Count() || - (oldProjectRefs, newProjectRefs) - ||> Seq.exists2 (fun p1 p2 -> - let doesProjectIdDiffer = p1.ProjectId <> p2.ProjectId - let p1 = oldProject.Solution.GetProject(p1.ProjectId) - let p2 = newProject.Solution.GetProject(p2.ProjectId) - doesProjectIdDiffer || p1.Version <> p2.Version - ) - - let isProjectInvalidated (oldProject: Project) (newProject: Project) (settings: EditorOptions) = - let hasProjectVersionChanged = hasProjectVersionChanged oldProject newProject - if settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences then - hasProjectVersionChanged || hasDependentVersionChanged oldProject newProject - else - hasProjectVersionChanged - [] -type private FSharpProjectOptionsMessage = - | TryGetOptionsByDocument of Document * AsyncReplyChannel<(FSharpParsingOptions * FSharpProjectOptions) option> * CancellationToken - | TryGetOptionsByProject of Project * AsyncReplyChannel<(FSharpParsingOptions * FSharpProjectOptions) option> * CancellationToken - | ClearOptions of ProjectId - | ClearSingleFileOptionsCache of DocumentId - -[] -type private FSharpProjectOptionsReactor (workspace: VisualStudioWorkspaceImpl, settings: EditorOptions, serviceProvider, checkerProvider: FSharpCheckerProvider) = - let cancellationTokenSource = new CancellationTokenSource() +module internal FSharpCompilationHelpers = + + [] + type cenv = + { + checker: FSharpChecker + cache: ConcurrentDictionary + // Hack to store command line options from HandleCommandLineChanges, remove it when HandleCommandLineChanges gets removed. + cpsCommandLineOptions: ConcurrentDictionary + enableInMemoryCrossProjectReferences: bool + /// We only use the workspace directly when checking to see if something is from cps or legacy projects. + /// This will go away when cps and legacy are fully unified to the workspace, meaning we can get command line options and file ordered documents from a workspace project. + /// This will most likely be removed when 'cpsCommandLineOptions' gets removed. + workspace: Workspace + mutable currentSolution: Solution option + } - // Hack to store command line options from HandleCommandLineChanges - let cpsCommandLineOptions = new ConcurrentDictionary() + let createCompilationEnv workspace checker enableInMemoryCrossProjectReferences = + { + checker = checker + cache = ConcurrentDictionary () + cpsCommandLineOptions = ConcurrentDictionary () + enableInMemoryCrossProjectReferences = enableInMemoryCrossProjectReferences + workspace = workspace + currentSolution = None + } - let cache = Dictionary() - let singleFileCache = Dictionary() + let invalidateProjectCache cenv projectId = + cenv.cache.TryRemove projectId |> ignore + + let setProjectCache cenv (project: Project) parsingOptions projectOptions = + cenv.cache.[project.Id] <- (project, parsingOptions, projectOptions) + + let updateProject cenv (project: Project) = + match cenv.cache.TryGetValue project.Id with + | true, (_, parsingOptions, projectOptions) -> + setProjectCache cenv project parsingOptions projectOptions + | _ -> + () + + let invalidateProject cenv projectId = + match cenv.cache.TryGetValue projectId with + | true, (_, _, projectOptions) -> + Logging.Logging.logInfof "*** fully invalidate project - %A" projectId + invalidateProjectCache cenv projectId + cenv.cpsCommandLineOptions.TryRemove projectId |> ignore + cenv.checker.InvalidateProject projectOptions + | _ -> () + + let clearCaches cenv = + // We don't clear cpsCommandLineOptions as it could be dangerous, we only try to remove from cpsCommandLineOptions invdividual projects. + cenv.cache.Clear () + cenv.checker.StopBackgroundCompile () + cenv.checker.InvalidateAll () + + let setSolution cenv (solution: Solution) = + let checker = cenv.checker + match cenv.currentSolution with + | Some oldSolution when solution.Id <> oldSolution.Id -> + clearCaches cenv + + | Some oldSolution when solution.Version <> oldSolution.Version -> + checker.StopBackgroundCompile () + Logging.Logging.logInfof "*** solution version: %A -- old solution version: %A" (solution.Version.GetHashCode()) (oldSolution.Version.GetHashCode()) + let changes = solution.GetChanges oldSolution + for removedProject in changes.GetRemovedProjects() do + invalidateProject cenv removedProject.Id + + | _ -> () + + cenv.currentSolution <- Some solution + + let hasProjectChanged (oldProject: Project) (project: Project) = + oldProject.Version <> project.Version + + let checkProject cenv (oldProject: Project) (newProject: Project) ct = + async { + Debug.Assert (oldProject.Id = newProject.Id) + + // while we are not invalidated, we should update the project itself in the cache. + updateProject cenv newProject + + if hasProjectChanged oldProject newProject then + Logging.Logging.logInfof "*** invalidate project cache - %A" oldProject.Id + invalidateProjectCache cenv oldProject.Id + return false + elif cenv.enableInMemoryCrossProjectReferences then + let! oldVersion = oldProject.GetDependentVersionAsync ct |> Async.AwaitTask + let! newVersion = newProject.GetDependentVersionAsync ct |> Async.AwaitTask + + if oldVersion <> newVersion then + // invalidate any project that depends on this project + newProject.Solution.GetProjectDependencyGraph().GetProjectsThatTransitivelyDependOnThisProject newProject.Id + |> Seq.iter (fun projectId -> + Logging.Logging.logInfof "*** Depend on this project - invalidate project cache - %A" projectId + invalidateProjectCache cenv projectId + ) + + return true + else + return true + else + return true + } - let rec tryComputeOptionsByFile (document: Document) (ct: CancellationToken) = + let rec tryComputeOptionsByFile cenv (document: Document) (ct: CancellationToken) = async { - let! fileStamp = document.GetTextVersionAsync(ct) |> Async.AwaitTask - match singleFileCache.TryGetValue(document.Id) with + let isScript = isScriptFile document.FilePath + match cenv.cache.TryGetValue(document.Project.Id) with | false, _ -> + let checker = cenv.checker let! sourceText = document.GetTextAsync(ct) |> Async.AwaitTask - let! scriptProjectOptions, _ = checkerProvider.Checker.GetProjectOptionsFromScript(document.FilePath, sourceText.ToFSharpSourceText()) - let projectOptions = - if isScriptFile document.FilePath then - scriptProjectOptions + let! projectOptions, _ = + if isScript then + checker.GetProjectOptionsFromScript(document.FilePath, sourceText.ToFSharpSourceText()) else - { - ProjectFileName = document.FilePath - ProjectId = None - SourceFiles = [|document.FilePath|] - OtherOptions = [||] - ReferencedProjects = [||] - IsIncompleteTypeCheckEnvironment = false - UseScriptResolutionRules = SourceFile.MustBeSingleFileProject (Path.GetFileName(document.FilePath)) - LoadTime = DateTime.Now - UnresolvedReferences = None - OriginalLoadReferences = [] - ExtraProjectInfo= None - Stamp = Some(int64 (fileStamp.GetHashCode())) + async { + return { + ProjectFileName = document.FilePath + ProjectId = None + SourceFiles = [|document.FilePath|] + OtherOptions = [||] + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = SourceFile.MustBeSingleFileProject (Path.GetFileName(document.FilePath)) + LoadTime = DateTime.Now + UnresolvedReferences = None + OriginalLoadReferences = [] + ExtraProjectInfo= None + Stamp = None + }, Unchecked.defaultof<_> } - checkerProvider.Checker.CheckProjectInBackground(projectOptions, userOpName="checkOptions") + checker.CheckProjectInBackground(projectOptions, userOpName="checkOptions") - let parsingOptions, _ = checkerProvider.Checker.GetParsingOptionsFromProjectOptions(projectOptions) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions(projectOptions) - singleFileCache.[document.Id] <- (fileStamp, parsingOptions, projectOptions) + setProjectCache cenv document.Project parsingOptions projectOptions return Some(parsingOptions, projectOptions) - | true, (fileStamp2, parsingOptions, projectOptions) -> - if fileStamp <> fileStamp2 then - singleFileCache.Remove(document.Id) |> ignore - return! tryComputeOptionsByFile document ct + | true, (oldProject, parsingOptions, projectOptions) -> + let! version = document.Project.GetDependentVersionAsync ct |> Async.AwaitTask + let! oldVersion = oldProject.GetDependentVersionAsync ct |> Async.AwaitTask + // Only recompute if it's a script. + if version <> oldVersion && isScript then + invalidateProjectCache cenv oldProject.Id + return! tryComputeOptionsByFile cenv document ct else return Some(parsingOptions, projectOptions) } - let rec tryComputeOptions (project: Project) = + let rec tryComputeOptions cenv (project: Project) (ct: CancellationToken) = async { let projectId = project.Id - match cache.TryGetValue(projectId) with + match cenv.cache.TryGetValue(projectId) with | false, _ -> // Because this code can be kicked off before the hack, HandleCommandLineChanges, occurs, @@ -171,11 +217,11 @@ type private FSharpProjectOptionsReactor (workspace: VisualStudioWorkspaceImpl, let referencedProjects = ResizeArray() - if settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences then + if cenv.enableInMemoryCrossProjectReferences then for projectReference in project.ProjectReferences do let referencedProject = project.Solution.GetProject(projectReference.ProjectId) if referencedProject.Language = FSharpConstants.FSharpLanguageName then - match! tryComputeOptions referencedProject with + match! tryComputeOptions cenv referencedProject ct with | None -> canBail <- true | Some(_, projectOptions) -> referencedProjects.Add(referencedProject.OutputFilePath, projectOptions) @@ -183,15 +229,15 @@ type private FSharpProjectOptionsReactor (workspace: VisualStudioWorkspaceImpl, return None else - let hier = workspace.GetHierarchy(projectId) let projectSite = - match hier with - // Legacy - | (:? IProvideProjectSite as provideSite) -> provideSite.GetProjectSite() - // Cps - | _ -> - let provideSite = mapCpsProjectToSite(workspace, project, serviceProvider, cpsCommandLineOptions) - provideSite.GetProjectSite() + match cenv.workspace with + | (:? VisualStudioWorkspace as workspace) -> + match workspace.GetHierarchy (projectId) with + // Legacy + | (:? IProvideProjectSite as provideSite) -> provideSite.GetProjectSite() + // Cps + | _ -> mapCpsProjectToSite(project, cenv.cpsCommandLineOptions) + | _ -> mapCpsProjectToSite(project, cenv.cpsCommandLineOptions) let otherOptions = project.ProjectReferences @@ -229,62 +275,82 @@ type private FSharpProjectOptionsReactor (workspace: VisualStudioWorkspaceImpl, if Array.isEmpty projectOptions.SourceFiles then return None else - checkerProvider.Checker.InvalidateConfiguration(projectOptions, startBackgroundCompileIfAlreadySeen = false, userOpName = "computeOptions") + let checker = cenv.checker + + Logging.Logging.logInfof "*** computing project - %A version: %A" project.Name project.Version - let parsingOptions, _ = checkerProvider.Checker.GetParsingOptionsFromProjectOptions(projectOptions) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions(projectOptions) - cache.[projectId] <- (project, parsingOptions, projectOptions) + setProjectCache cenv project parsingOptions projectOptions return Some(parsingOptions, projectOptions) | true, (oldProject, parsingOptions, projectOptions) -> - if isProjectInvalidated oldProject project settings then - cache.Remove(projectId) |> ignore - return! tryComputeOptions project - else + match! checkProject cenv oldProject project ct with + | false -> + return! tryComputeOptions cenv project ct + | true -> return Some(parsingOptions, projectOptions) } +[] +type private FSharpProjectOptionsMessage = + | TryGetOptionsByDocument of Document * AsyncReplyChannel<(FSharpParsingOptions * FSharpProjectOptions) option> * CancellationToken + | TryGetOptionsByProject of Project * AsyncReplyChannel<(FSharpParsingOptions * FSharpProjectOptions) option> * CancellationToken + | ClearCaches + +[] +type private FSharpProjectOptionsReactor (workspace: VisualStudioWorkspace, settings: EditorOptions, checkerProvider: FSharpCheckerProvider) = + let cancellationTokenSource = new CancellationTokenSource() + + let cenv = FSharpCompilationHelpers.createCompilationEnv workspace checkerProvider.Checker settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences + + let isSolutionValid (solution1: Solution) (solution2: Solution) = + solution1.Id <> solution2.Id || solution1.Version <> solution2.Version + let loop (agent: MailboxProcessor) = async { while true do match! agent.Receive() with | FSharpProjectOptionsMessage.TryGetOptionsByDocument(document, reply, ct) -> - if ct.IsCancellationRequested then + if ct.IsCancellationRequested || isSolutionValid workspace.CurrentSolution document.Project.Solution then reply.Reply None else try - // For now, disallow miscellaneous workspace since we are using the hacky F# miscellaneous files project. - if document.Project.Solution.Workspace.Kind = WorkspaceKind.MiscellaneousFiles then - reply.Reply None - elif document.Project.Name = FSharpConstants.FSharpMiscellaneousFilesName then - let! options = tryComputeOptionsByFile document ct - reply.Reply options + // We only allow solutions from the VisualStudioWorkspace. + if obj.ReferenceEquals (document.Project.Solution.Workspace, workspace) then + FSharpCompilationHelpers.setSolution cenv workspace.CurrentSolution + if document.Project.Name = FSharpConstants.FSharpMiscellaneousFilesName then + let! options = FSharpCompilationHelpers.tryComputeOptionsByFile cenv document ct + reply.Reply options + else + let! options = FSharpCompilationHelpers.tryComputeOptions cenv document.Project ct + reply.Reply options else - let! options = tryComputeOptions document.Project - reply.Reply options + reply.Reply None with | _ -> reply.Reply None | FSharpProjectOptionsMessage.TryGetOptionsByProject(project, reply, ct) -> - if ct.IsCancellationRequested then + if ct.IsCancellationRequested || isSolutionValid workspace.CurrentSolution project.Solution then reply.Reply None else try - if project.Solution.Workspace.Kind = WorkspaceKind.MiscellaneousFiles || project.Name = FSharpConstants.FSharpMiscellaneousFilesName then - reply.Reply None - else - let! options = tryComputeOptions project + // We only allow solutions from the VisualStudioWorkspace. + // Do not process misc files here. + if obj.ReferenceEquals (project.Solution.Workspace, workspace) && not (project.Name = FSharpConstants.FSharpMiscellaneousFilesName) then + FSharpCompilationHelpers.setSolution cenv workspace.CurrentSolution + let! options = FSharpCompilationHelpers.tryComputeOptions cenv project ct reply.Reply options + else + reply.Reply None with | _ -> reply.Reply None - | FSharpProjectOptionsMessage.ClearOptions(projectId) -> - cache.Remove(projectId) |> ignore - | FSharpProjectOptionsMessage.ClearSingleFileOptionsCache(documentId) -> - singleFileCache.Remove(documentId) |> ignore + | FSharpProjectOptionsMessage.ClearCaches -> + FSharpCompilationHelpers.clearCaches cenv } let agent = MailboxProcessor.Start((fun agent -> loop agent), cancellationToken = cancellationTokenSource.Token) @@ -295,17 +361,15 @@ type private FSharpProjectOptionsReactor (workspace: VisualStudioWorkspaceImpl, member __.TryGetOptionsByDocumentAsync(document, ct) = agent.PostAndAsyncReply(fun reply -> FSharpProjectOptionsMessage.TryGetOptionsByDocument(document, reply, ct)) - member __.ClearOptionsByProjectId(projectId) = - agent.Post(FSharpProjectOptionsMessage.ClearOptions(projectId)) - - member __.ClearSingleFileOptionsCache(documentId) = - agent.Post(FSharpProjectOptionsMessage.ClearSingleFileOptionsCache(documentId)) - member __.SetCpsCommandLineOptions(projectId, sourcePaths, options) = - cpsCommandLineOptions.[projectId] <- (sourcePaths, options) + cenv.cpsCommandLineOptions.[projectId] <- (sourcePaths, options) + + member __.Reset () = + cenv.cpsCommandLineOptions.Clear () + agent.Post FSharpProjectOptionsMessage.ClearCaches member __.TryGetCachedOptionsByProjectId(projectId) = - match cache.TryGetValue(projectId) with + match cenv.cache.TryGetValue(projectId) with | true, result -> Some(result) | _ -> None @@ -326,7 +390,6 @@ type internal FSharpProjectOptionsManager ( checkerProvider: FSharpCheckerProvider, [)>] workspace: VisualStudioWorkspaceImpl, - [)>] serviceProvider: System.IServiceProvider, settings: EditorOptions ) = @@ -334,22 +397,11 @@ type internal FSharpProjectOptionsManager if String.IsNullOrWhiteSpace projectFileName then projectFileName else Path.GetFileNameWithoutExtension projectFileName - let reactor = new FSharpProjectOptionsReactor(workspace, settings, serviceProvider, checkerProvider) - - do - // We need to listen to this event for lifecycle purposes. - workspace.WorkspaceChanged.Add(fun args -> - match args.Kind with - | WorkspaceChangeKind.ProjectRemoved -> reactor.ClearOptionsByProjectId(args.ProjectId) - | _ -> () - ) + let reactor = new FSharpProjectOptionsReactor(workspace, settings, checkerProvider) - /// Clear a project from the project table - member this.ClearInfoForProject(projectId:ProjectId) = - reactor.ClearOptionsByProjectId(projectId) - - member this.ClearSingleFileOptionsCache(documentId) = - reactor.ClearSingleFileOptionsCache(documentId) + /// Dangerous reset, only call when you close a solution. + member __.Reset () = + reactor.Reset () /// Get compilation defines relevant for syntax processing. /// Quicker then TryGetOptionsForDocumentOrProject as it doesn't need to recompute the exact project @@ -394,12 +446,13 @@ type internal FSharpProjectOptionsManager | true, project -> project.Id | false, _ -> workspace.ProjectTracker.GetOrCreateProjectIdForPath(path, projectDisplayNameOf path) let project = workspace.ProjectTracker.GetProject(projectId) - let path = project.ProjectFilePath - let fullPath p = - if Path.IsPathRooted(p) || path = null then p - else Path.Combine(Path.GetDirectoryName(path), p) - let sourcePaths = sources |> Seq.map(fun s -> fullPath s.Path) |> Seq.toArray - - reactor.SetCpsCommandLineOptions(projectId, sourcePaths, options.ToArray()) + if project <> null then + let path = project.ProjectFilePath + let fullPath p = + if Path.IsPathRooted(p) || path = null then p + else Path.Combine(Path.GetDirectoryName(path), p) + let sourcePaths = sources |> Seq.map(fun s -> fullPath s.Path) |> Seq.toArray + + reactor.SetCpsCommandLineOptions(projectId, sourcePaths, options.ToArray()) member __.Checker = checkerProvider.Checker diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs index da7ae84baf2..329ba643f3b 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs @@ -71,7 +71,7 @@ type internal FSharpCheckerWorkspaceServiceFactory member this.CreateService(_workspaceServices) = upcast { new FSharpCheckerWorkspaceService with member this.Checker = checkerProvider.Checker - member this.FSharpProjectOptionsManager = projectInfoManager } + member this.FSharpProjectOptionsManager = projectInfoManager } [] type private FSharpSolutionEvents(projectManager: FSharpProjectOptionsManager) = @@ -79,7 +79,7 @@ type private FSharpSolutionEvents(projectManager: FSharpProjectOptionsManager) = interface IVsSolutionEvents with member __.OnAfterCloseSolution(_) = - projectManager.Checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() + projectManager.Reset () VSConstants.S_OK member __.OnAfterLoadProject(_, _) = VSConstants.E_NOTIMPL @@ -98,7 +98,7 @@ type private FSharpSolutionEvents(projectManager: FSharpProjectOptionsManager) = member __.OnQueryCloseSolution(_, _) = VSConstants.E_NOTIMPL - member __.OnQueryUnloadProject(_, _) = VSConstants.E_NOTIMPL + member __.OnQueryUnloadProject(_, _) = VSConstants.E_NOTIMPL [, Microsoft.CodeAnalysis.Host.Mef.ServiceLayer.Default)>] type internal FSharpSettingsFactory @@ -170,7 +170,7 @@ type internal FSharpPackage() as this = vfsiToolWindow <- this.FindToolWindow(typeof, 0, true) :?> Microsoft.VisualStudio.FSharp.Interactive.FsiToolWindow vfsiToolWindow :> Microsoft.VisualStudio.FSharp.Interactive.ITestVFSI - let mutable solutionEventsOpt = None + let mutable solutionEventsOpt = None // this is meant to strongly hold onto solution events // FSI-LINKAGE-POINT: unsited init do @@ -204,8 +204,8 @@ type internal FSharpPackage() as this = let projectContextFactory = this.ComponentModel.GetService() let workspace = this.ComponentModel.GetService() let miscFilesWorkspace = this.ComponentModel.GetService() - let _singleFileWorkspaceMap = new SingleFileWorkspaceMap(workspace, miscFilesWorkspace, projectInfoManager, projectContextFactory, rdt) - let _legacyProjectWorkspaceMap = new LegacyProjectWorkspaceMap(solution, projectInfoManager, projectContextFactory) + let _singleFileWorkspaceMap = new SingleFileWorkspaceMap(workspace, miscFilesWorkspace, projectContextFactory, rdt) + let _legacyProjectWorkspaceMap = new LegacyProjectWorkspaceMap(solution, projectContextFactory) () let awaiter = this.JoinableTaskFactory.SwitchToMainThreadAsync().GetAwaiter() if awaiter.IsCompleted then diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LegacyProjectWorkspaceMap.fs b/vsintegration/src/FSharp.Editor/LanguageService/LegacyProjectWorkspaceMap.fs index 0bf2e5c8063..eb7311cd90f 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/LegacyProjectWorkspaceMap.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/LegacyProjectWorkspaceMap.fs @@ -19,8 +19,7 @@ open Microsoft.VisualStudio.LanguageServices.ProjectSystem open Microsoft.VisualStudio.Shell.Interop [] -type internal LegacyProjectWorkspaceMap(solution: IVsSolution, - projectInfoManager: FSharpProjectOptionsManager, +type internal LegacyProjectWorkspaceMap(solution: IVsSolution, projectContextFactory: IWorkspaceProjectContextFactory) as this = let invalidPathChars = set (Path.GetInvalidPathChars()) @@ -136,8 +135,7 @@ type internal LegacyProjectWorkspaceMap(solution: IVsSolution, AdviseProjectSiteChanges(fun () -> this.SyncLegacyProject(projectContext, site))) site.AdviseProjectSiteClosed(FSharpConstants.FSharpLanguageServiceCallbackName, - AdviseProjectSiteChanges(fun () -> - projectInfoManager.ClearInfoForProject(projectContext.Id) + AdviseProjectSiteChanges(fun () -> optionsAssociation.Remove(projectContext) |> ignore projectContext.Dispose())) diff --git a/vsintegration/src/FSharp.Editor/LanguageService/SingleFileWorkspaceMap.fs b/vsintegration/src/FSharp.Editor/LanguageService/SingleFileWorkspaceMap.fs index 21249b80c5f..f2ed350edea 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/SingleFileWorkspaceMap.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/SingleFileWorkspaceMap.fs @@ -15,7 +15,6 @@ open Microsoft.VisualStudio.LanguageServices [] type internal SingleFileWorkspaceMap(workspace: VisualStudioWorkspace, miscFilesWorkspace: MiscellaneousFilesWorkspace, - optionsManager: FSharpProjectOptionsManager, projectContextFactory: IWorkspaceProjectContextFactory, rdt: IVsRunningDocumentTable) as this = @@ -45,7 +44,6 @@ type internal SingleFileWorkspaceMap(workspace: VisualStudioWorkspace, if document.Project.Language = FSharpConstants.FSharpLanguageName && document.Project.Name <> FSharpConstants.FSharpMiscellaneousFilesName then match files.TryRemove(document.FilePath) with | true, projectContext -> - optionsManager.ClearSingleFileOptionsCache(document.Id) projectContext.Dispose() | _ -> () ) @@ -54,7 +52,6 @@ type internal SingleFileWorkspaceMap(workspace: VisualStudioWorkspace, let document = args.Document match files.TryRemove(document.FilePath) with | true, projectContext -> - optionsManager.ClearSingleFileOptionsCache(document.Id) projectContext.Dispose() | _ -> () ) @@ -84,20 +81,9 @@ type internal SingleFileWorkspaceMap(workspace: VisualStudioWorkspace, // Handles renaming of a misc file if (grfAttribs &&& (uint32 __VSRDTATTRIB.RDTA_MkDocument)) <> 0u && files.ContainsKey(pszMkDocumentOld) then match files.TryRemove(pszMkDocumentOld) with - | true, projectContext -> - let project = workspace.CurrentSolution.GetProject(projectContext.Id) - if project <> null then - let documentOpt = - project.Documents - |> Seq.tryFind (fun x -> String.Equals(x.FilePath, pszMkDocumentOld, StringComparison.OrdinalIgnoreCase)) - match documentOpt with - | None -> () - | Some(document) -> - optionsManager.ClearSingleFileOptionsCache(document.Id) - projectContext.Dispose() - files.[pszMkDocumentNew] <- createProjectContext pszMkDocumentNew - else - projectContext.Dispose() // fallback, shouldn't happen, but in case it does let's dispose of the project context so we don't leak + | true, projectContext -> + projectContext.Dispose() + files.[pszMkDocumentNew] <- createProjectContext pszMkDocumentNew | _ -> () VSConstants.S_OK diff --git a/vsintegration/tests/UnitTests/CacheTests.fs b/vsintegration/tests/UnitTests/CacheTests.fs new file mode 100644 index 00000000000..21ce9b9d9ed --- /dev/null +++ b/vsintegration/tests/UnitTests/CacheTests.fs @@ -0,0 +1,149 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn + +open System.IO +open System.Threading +open NUnit.Framework +open Microsoft.VisualStudio.FSharp.Editor +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Text +open UnitTests.TestLib.LanguageService + +[] +type CacheTests() = + + let testPath = """C:\test\""" + let testFileName = "TestFile.fs" + let testFilePath = Path.Combine(testPath, testFileName) + let testFileSourceText = SourceText.From("""module TestProject.TestFile""") + + let createTestProjectInfo name = + let projectId = ProjectId.CreateNewId () + let documentInfos = + [ + DocumentInfo.Create (DocumentId.CreateNewId (projectId), testFileName) + ] + let dllPath = Path.Combine(testPath, name + ".dll") + let projectPath = Path.Combine(testPath, name + ".fsproj") + ProjectInfo.Create (projectId, VersionStamp.Create (), name, name, (* Can't use "F#" due to exception *) "C#", documents = documentInfos, outputFilePath = dllPath, filePath = projectPath) + + let createSolutionInfoWithProjectCount projectCount = + let testProjectInfos = [ for i = 1 to projectCount do yield createTestProjectInfo ("Test" + string i) ] + let solutionInfo = SolutionInfo.Create(SolutionId.CreateNewId (), VersionStamp.Create (), projects = testProjectInfos) + solutionInfo + + let createCompilationEnvWithProjectCount projectCount = + let solutionInfo = createSolutionInfoWithProjectCount projectCount + let projectInfos = solutionInfo.Projects + let workspace = new AdhocWorkspace() + workspace.AddSolution solutionInfo |> ignore + + let cenv = FSharpCompilationHelpers.createCompilationEnv workspace checker (* enableInMemoryCrossProjectReferences *) true + + // This will go away when HandleCommandLineChanges goes away. + projectInfos + |> Seq.iter (fun testProjectInfo -> + cenv.cpsCommandLineOptions.[testProjectInfo.Id] <- ([|testFilePath|], [||]) + ) + + (workspace, cenv) + + let basicTest () = + let (workspace, cenv) = createCompilationEnvWithProjectCount 3 (* we chose 3 because the Checker's default project cache size is 3 by default *) + let checker = cenv.checker + + checker.StopBackgroundCompile () + checker.InvalidateAll () + + // We shouldn't have a current solution yet. + Assert.True (cenv.currentSolution.IsNone) + + let fsharpProjects = + workspace.CurrentSolution.Projects + |> Seq.map (fun project -> + FSharpCompilationHelpers.tryComputeOptions cenv project CancellationToken.None |> Async.RunSynchronously + ) + |> List.ofSeq + + // We still don't have a current solution yet. + Assert.True (cenv.currentSolution.IsNone) + + FSharpCompilationHelpers.setSolution cenv workspace.CurrentSolution + + // We should now have a current solution. + Assert.True (cenv.currentSolution.IsSome) + + Assert.True (fsharpProjects |> List.forall (fun x -> x.IsSome)) + + let fsharpProjects = fsharpProjects |> List.map (fun x -> snd x.Value) + + Assert.True (fsharpProjects |> List.forall (fun options -> not (checker.ProjectExistsInAnyCache options |> Async.RunSynchronously))) + + fsharpProjects + |> List.iter (fun options -> + // We don't care about the results, we only care that it will create an incremental builder for each project when we make a call. + checker.TryParseAndCheckFileInProject(options, testFilePath, testFileSourceText, "CacheTests") |> Async.RunSynchronously |> ignore + ) + + // Projects should now exist in the cache. + Assert.True (fsharpProjects |> List.forall (fun options -> checker.ProjectExistsInAnyCache options |> Async.RunSynchronously)) + (workspace, cenv) + + [] + member __.ProjectCacheRemoveInvdividuallyBySolutionChanges () = + let (workspace, cenv) = basicTest () + let checker = cenv.checker + + let mutable solution = workspace.CurrentSolution + let projectIds = solution.ProjectIds + let fsharpProjects = + projectIds + |> Seq.map (fun projectId -> + let (_, _, options) = cenv.cache.[projectId] + options + ) |> List.ofSeq + + Assert.AreEqual (3, projectIds.Count) + + for i = 0 to projectIds.Count - 1 do + solution <- solution.RemoveProject projectIds.[i] + FSharpCompilationHelpers.setSolution cenv solution + + // Remaining projects should still be in the cache. + for i = i + 1 to projectIds.Count - 1 do + Assert.True (cenv.cache.ContainsKey projectIds.[i]) + Assert.True (checker.ProjectExistsInAnyCache fsharpProjects.[i] |> Async.RunSynchronously) + + Assert.False (cenv.cache.ContainsKey projectIds.[i]) + Assert.False (checker.ProjectExistsInAnyCache fsharpProjects.[i] |> Async.RunSynchronously) + + workspace.Dispose () + + [] + member __.ProjectCacheRemoveAllByNewSolution () = + let (workspace, cenv) = basicTest () + let checker = cenv.checker + + let solution = workspace.CurrentSolution + let projectIds = solution.ProjectIds + let fsharpProjects = + projectIds + |> Seq.map (fun projectId -> + let (_, _, options) = cenv.cache.[projectId] + options + ) |> List.ofSeq + + Assert.AreEqual (3, projectIds.Count) + + workspace.ClearSolution () + let solution = workspace.AddSolution (createSolutionInfoWithProjectCount 0) + + FSharpCompilationHelpers.setSolution cenv solution + + for i = 0 to projectIds.Count - 1 do + Assert.False (cenv.cache.ContainsKey projectIds.[i]) + Assert.False (checker.ProjectExistsInAnyCache fsharpProjects.[i] |> Async.RunSynchronously) + + workspace.Dispose () + + diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj index e7adc88e631..a4568e71473 100644 --- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj +++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj @@ -110,6 +110,9 @@ CompilerService\TreeVisitorTests.fs + + Roslyn\CacheTests.fs + Roslyn\ProjectOptionsBuilder.fs