Parse each file of a multi-targeted F# project once in Go To All

docs/release-notes/.VisualStudio/18.vNext.md

@@ -23,6 +23,7 @@
 * Build a single-file project's `OtherOptions` reference flags with one array comprehension instead of two `Array.ofSeq` calls and an `Array.append`. ([PR #20499](https://github.com/dotnet/fsharp/pull/20499))
 * Fix syntax coloring being lost for a whole file when one symbol resolves into metadata that could not be read. ([Issue #20269](https://github.com/dotnet/fsharp/issues/20269), [PR #20274](https://github.com/dotnet/fsharp/pull/20274))
 * Go To Definition into an F# project built with a path map (`DeterministicSourcePaths` or `PathMap`) opens its source instead of a generated signature: the IDE no longer applies `--pathmap` to the project options it checks with. ([PR #20470](https://github.com/dotnet/fsharp/pull/20470))
+* Go To All (Ctrl+T) on a multi-targeted F# project no longer parses every file once per target framework. ([PR #20483](https://github.com/dotnet/fsharp/pull/20483))
 
 ### Changed
 

vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs

@@ -646,6 +646,9 @@ type internal FSharpProjectOptionsManager(checker: FSharpChecker, workspace: Wor
 
         CompilerEnvironment.GetConditionalDefinesForEditing parsingOptions, parsingOptions.LangVersionText
 
+    member _.TryGetCachedOptionsByProjectId(projectId) =
+        reactor.TryGetCachedOptionsByProjectId(projectId)
+
     member _.TryGetOptionsByProject(project) =
         reactor.TryGetOptionsByProjectAsync(project)
 

vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs

@@ -16,15 +16,22 @@ open Microsoft.CodeAnalysis.ExternalAccess.FSharp.NavigateTo
 open Microsoft.VisualStudio.LanguageServices
 open Microsoft.VisualStudio.Text.PatternMatching
 
+open FSharp.Compiler
 open FSharp.Compiler.EditorServices
+open FSharp.Compiler.Syntax
 open CancellableTasks
 
+[<Struct>]
+type private ParseKey =
+    | AnyDefines of filePath: string * langVersion: string
+    | DefinedAs of filePath: string * langVersion: string * defines: string list
+
 [<Export(typeof<IFSharpNavigateToSearchService>); Shared>]
 type internal FSharpNavigateToSearchService
     [<ImportingConstructor>]
     (patternMatcherFactory: IPatternMatcherFactory, [<Import(AllowDefault = true)>] workspace: VisualStudioWorkspace) =
 
-    let cache = ConcurrentDictionary<DocumentId, VersionStamp * NavigableItem array>()
+    let cache = ConcurrentDictionary<ParseKey, VersionStamp * NavigableItem array>()
 
     do
         if workspace <> null then
@@ -33,17 +40,48 @@ type internal FSharpNavigateToSearchService
                 if e.NewSolution.Id <> e.OldSolution.Id then
                     cache.Clear()
 
+    // Awaiting a project's options recomputes them after an edit to a C# project it references.
+    let parsingOptionsOf (document: Document) =
+        let optionsManager =
+            document.Project.Solution.GetFSharpWorkspaceService().FSharpProjectOptionsManager
+
+        match optionsManager.TryGetCachedOptionsByProjectId document.Project.Id with
+        | Some(_, parsingOptions, _) -> CancellableTask.singleton parsingOptions
+        | None ->
+            document.GetFSharpCompilationOptionsAsync(nameof (FSharpNavigateToSearchService))
+            |> CancellableTask.map (fun (_, _, parsingOptions, _) -> parsingOptions)
+
+    let storedUnder anyDefinesKey definedAsKey =
+        function
+        | ParsedInput.ImplFile(ParsedImplFileInput(trivia = trivia))
+        | ParsedInput.SigFile(ParsedSigFileInput(trivia = trivia)) when trivia.ConditionalDirectives.IsEmpty -> anyDefinesKey
+        | _ -> definedAsKey
+
     let getNavigableItems (document: Document) =
         cancellableTask {
             let! ct = CancellableTask.getCancellationToken ()
             let! currentVersion = document.GetTextVersionAsync(ct)
+            let! parsingOptions = parsingOptionsOf document
+            let anyDefinesKey = AnyDefines(document.FilePath, parsingOptions.LangVersionText)
+
+            let definedAsKey =
+                DefinedAs(
+                    document.FilePath,
+                    parsingOptions.LangVersionText,
+                    CompilerEnvironment.GetConditionalDefinesForEditing parsingOptions
+                )
 
-            match cache.TryGetValue document.Id with
-            | true, (version, items) when version = currentVersion -> return items
-            | _ ->
+            let cached key =
+                match cache.TryGetValue key with
+                | true, (version, items) when version = currentVersion -> ValueSome items
+                | _ -> ValueNone
+
+            match cached anyDefinesKey |> ValueOption.orElseWith (fun () -> cached definedAsKey) with
+            | ValueSome items -> return items
+            | ValueNone ->
                 let! parseResults = document.GetFSharpParseResultsAsync(nameof (FSharpNavigateToSearchService))
                 let items = NavigateTo.GetNavigableItems parseResults.ParseTree
-                cache[document.Id] <- currentVersion, items
+                cache[storedUnder anyDefinesKey definedAsKey parseResults.ParseTree] <- currentVersion, items
                 return items
         }
 
@@ -145,20 +183,26 @@ type internal FSharpNavigateToSearchService
 
     let processDocument (tryMatch: NavigableItem -> PatternMatch voption) (kinds: IImmutableSet<string>) (document: Document) =
         cancellableTask {
-            let! ct = CancellableTask.getCancellationToken ()
-
-            let! sourceText = document.GetTextAsync ct
-
             let! items = getNavigableItems document
 
-            let processed =
+            let matches =
                 [|
                     for item in items do
-                        let contains = kinds.Contains(navigateToItemKindToRoslynKind item.Kind)
-                        let patternMatch = tryMatch item
+                        if kinds.Contains(navigateToItemKindToRoslynKind item.Kind) then
+                            match tryMatch item with
+                            | ValueSome m -> yield struct (item, m)
+                            | ValueNone -> ()
+                |]
 
-                        match contains, patternMatch with
-                        | true, ValueSome m ->
+            if matches.Length = 0 then
+                return [||]
+            else
+                let! ct = CancellableTask.getCancellationToken ()
+                let! sourceText = document.GetTextAsync ct
+
+                return
+                    [|
+                        for struct (item, m) in matches do
                             let sourceSpan = RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, item.Range)
 
                             match sourceSpan with
@@ -181,10 +225,7 @@ type internal FSharpNavigateToSearchService
                                             sourceSpan
                                         )
                                     )
-                        | _ -> ()
-                |]
-
-            return processed
+                    |]
         }
 
     interface IFSharpNavigateToSearchService with
@@ -200,15 +241,9 @@ type internal FSharpNavigateToSearchService
                             yield processDocument tryMatch kinds doc
                     |]
 
-                let! results = CancellableTask.whenAll tasks
-
-                let results' = ImmutableArray.CreateBuilder()
-
-                for navResults in results do
-                    for navResult in navResults do
-                        results'.Add navResult
+                let! results = CancellableTask.whenAllThrottled (max 1 Environment.ProcessorCount) tasks
 
-                return results'.ToImmutable()
+                return results |> Array.concat |> Array.toImmutableArray
 
             }
             |> CancellableTask.start cancellationToken

vsintegration/tests/FSharp.Editor.Tests/FSharp.Editor.Tests.fsproj

@@ -33,6 +33,7 @@
     <Compile Include="QuickInfoTests.fs" />
     <Compile Include="TaskListServiceTests.fs" />
     <Compile Include="NavigateToSearchServiceTests.fs" />
+    <Compile Include="MultiTargetNavigateToSearchTests.fs" />
     <Compile Include="CodeFixes\CodeFixTestFramework.fs" />
     <Compile Include="CodeFixes\AddInstanceMemberParameterTests.fs" />
     <Compile Include="CodeFixes\ConvertToAnonymousRecordTests.fs" />

vsintegration/tests/FSharp.Editor.Tests/MultiTargetNavigateToSearchTests.fs

@@ -0,0 +1,84 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+module FSharp.Editor.Tests.MultiTargetNavigateToSearchTests
+
+open System.IO
+open Xunit
+open Microsoft.CodeAnalysis
+open Microsoft.CodeAnalysis.Text
+open FSharp.Editor.Tests.Helpers
+open FSharp.Test.ProjectGeneration
+
+let private exactNamesIn = NavigateToSearchServiceTests.exactNamesIn
+
+let private syntheticProject =
+    SyntheticProject.Create(
+        { sourceFile "Plain" [] with
+            ExtraSource = "let plainUse = 1"
+        },
+        { sourceFile "Conditional" [] with
+            ExtraSource = "#if FOO\nlet fooUse = 1\n#endif"
+        }
+    )
+
+let private linkedText path (text: string) (solution: Solution) =
+    let linked = TextAndVersion.Create(SourceText.From text, VersionStamp.Create())
+
+    (solution, solution.GetDocumentIdsWithFilePath path)
+    ||> Seq.fold (fun (solution: Solution) id -> solution.WithDocumentText(id, linked))
+
+[<AutoOpen>]
+module private Fixture =
+    let struct (unlinked, instances) =
+        RoslynTestHelpers.CreateMultiTargetSolution(
+            syntheticProject,
+            [ for defs in [ []; [ "FOO" ] ] -> { Defines = defs; ExcludedFileIds = [] } ]
+        )
+
+    let solution =
+        (unlinked, syntheticProject.SourceFilePaths)
+        ||> List.fold (fun solution path -> linkedText path (File.ReadAllText path) solution)
+
+    let withoutFoo, withFoo = instances[0], instances[1]
+
+[<Theory>]
+[<InlineData(0)>]
+[<InlineData(1)>]
+let ``an instance reports a shared declaration on its own, and again once the parse is cached`` (instance: int) =
+    let project = solution.GetProject instances[instance]
+
+    Assert.Equal<string list>([ "plainUse" ], exactNamesIn project "plainUse")
+    Assert.Equal<string list>([ "plainUse" ], exactNamesIn project "plainUse")
+
+[<Fact>]
+let ``an instance reuses the parse another instance made of the same text`` () =
+    let path = syntheticProject.GetFilePath "Plain"
+    let linked = linkedText path "module ModulePlain\nlet reusedUse = 1\n" solution
+
+    let searchEveryInstance () =
+        for instance in instances do
+            Assert.Equal<string list>([ "reusedUse" ], exactNamesIn (linked.GetProject instance) "reusedUse")
+
+    Assert.Equal(1, NavigateToSearchServiceTests.countParseRequests path searchEveryInstance)
+
+[<Fact>]
+let ``a declaration behind a directive is reported only by the instance that defines it`` () =
+    Assert.Equal<string list>([ "fooUse" ], exactNamesIn (solution.GetProject withFoo) "fooUse")
+    Assert.Equal<string list>([], exactNamesIn (solution.GetProject withoutFoo) "fooUse")
+
+[<Theory>]
+[<InlineData(false)>]
+[<InlineData(true)>]
+let ``a declaration an edit puts behind a directive is reported by the instance that defines it`` (fooFirst: bool) =
+    Assert.Equal<string list>([ "plainUse" ], exactNamesIn (solution.GetProject withoutFoo) "plainUse")
+
+    let edited =
+        solution.WithDocumentText(
+            solution.GetDocumentIdsWithFilePath(syntheticProject.GetFilePath "Plain"),
+            SourceText.From "module ModulePlain\n#if FOO\nlet addedFoo = 1\n#endif\n"
+        )
+
+    let searches = [ withoutFoo, []; withFoo, [ "addedFoo" ] ]
+
+    for instance, expected in (if fooFirst then List.rev searches else searches) do
+        Assert.Equal<string list>(expected, exactNamesIn (edited.GetProject instance) "addedFoo")

vsintegration/tests/FSharp.Editor.Tests/NavigateToSearchServiceTests.fs

@@ -3,7 +3,9 @@
 namespace FSharp.Editor.Tests
 
 open Xunit
+open System.Diagnostics
 open System.Threading
+open Microsoft.CodeAnalysis
 open Microsoft.CodeAnalysis.Text
 open Microsoft.VisualStudio.FSharp.Editor
 open FSharp.Compiler.Text
@@ -38,13 +40,40 @@ module HeyHo =
     let project = solution.Projects |> Seq.exactlyOne
     let provider = MefHelpers.createExportProvider ()
 
-    let navigateToSearch pattern =
+    let navigateToSearch (project: Project) pattern =
         let service: IFSharpNavigateToSearchService = provider.GetExportedValue()
 
         service.SearchProjectAsync(project, [] |> Seq.toImmutableArray, pattern, service.KindsProvided, CancellationToken.None).Result
 
+    let exactNamesIn project pattern =
+        navigateToSearch project pattern
+        |> Seq.map _.Name
+        |> Seq.filter ((=) pattern)
+        |> Seq.toList
+
+    let countParseRequests (path: string) searches =
+        let isParseOfPath (activity: Activity) =
+            activity.OperationName = "BackgroundCompiler.ParseFile"
+            && activity.Tags |> Seq.exists (fun tag -> tag.Value = path)
+
+        let parseRequests = ref 0
+
+        use listener =
+            new ActivityListener(
+                ShouldListenTo = (fun source -> source.Name = FSharp.Compiler.Diagnostics.ActivityNames.FscSourceName),
+                Sample = (fun _ -> ActivitySamplingResult.AllData),
+                ActivityStarted =
+                    (fun activity ->
+                        if isParseOfPath activity then
+                            Interlocked.Increment(&parseRequests.contents) |> ignore)
+            )
+
+        ActivitySource.AddActivityListener listener
+        searches ()
+        parseRequests.Value
+
     let assertResultsContain pattern expected =
-        navigateToSearch pattern
+        navigateToSearch project pattern
         |> Seq.exists (fun i -> i.Name = expected)
         |> Assert.True
 
@@ -72,3 +101,53 @@ module HeyHo =
     [<Fact>]
     let ``nested containers`` () =
         assertResultsContain "hh.a.b.g.d" "Delta"
+
+    [<Fact>]
+    let ``a project whose options have not arrived does not answer from another project's parse`` () =
+        let path = "C:\\Shared.fs"
+        let definesNothingId, noOptionsId = ProjectId.CreateNewId(), ProjectId.CreateNewId()
+
+        let file =
+            RoslynTestHelpers.CreateDocumentInfo definesNothingId path "module Shared\n#if FOO\nlet fooOnly = 1\n#endif\nlet always = 2\n"
+
+        let sameVersionFile = file.WithId(DocumentId.CreateNewId noOptionsId)
+
+        let solution =
+            RoslynTestHelpers.CreateSolution
+                [
+                    RoslynTestHelpers.CreateProjectInfo definesNothingId "C:\\DefinesNothing.fsproj" [ file ]
+                    RoslynTestHelpers.CreateProjectInfo noOptionsId "C:\\NoOptions.fsproj" [ sameVersionFile ]
+                ]
+
+        { RoslynTestHelpers.DefaultProjectOptions with
+            SourceFiles = [| path |]
+        }
+        |> RoslynTestHelpers.SetProjectOptions definesNothingId solution
+
+        Assert.Equal<string list>([ "always" ], exactNamesIn (solution.GetProject definesNothingId) "always")
+
+        let searching =
+            Assert.ThrowsAny<exn>(fun () -> exactNamesIn (solution.GetProject noOptionsId) "always" |> ignore)
+
+        Assert.IsAssignableFrom<System.OperationCanceledException>(searching.GetBaseException())
+
+    [<Fact>]
+    let ``a repeated search of an unchanged standalone script does not parse it again`` () =
+        let path = "C:\\Standalone.fsx"
+        let projectId = ProjectId.CreateNewId()
+
+        let solution =
+            [
+                RoslynTestHelpers.CreateDocumentInfo projectId path "let standaloneValue = 1\n"
+            ]
+            |> RoslynTestHelpers.CreateProjectInfo projectId FSharpConstants.FSharpMiscellaneousFilesName
+            |> List.singleton
+            |> RoslynTestHelpers.CreateSolution
+
+        let script = solution.GetProject projectId
+
+        let searchTwice () =
+            for _ in 1..2 do
+                Assert.Equal<string list>([ "standaloneValue" ], exactNamesIn script "standaloneValue")
+
+        Assert.Equal(1, countParseRequests path searchTwice)