Add tests for cross-file active pattern references and enhance existing patterns

Author: TheAngryByrd

src/FsAutoComplete.Core/Commands.fs

@@ -842,16 +842,15 @@ module Commands =
         let dict = ConcurrentDictionary()
 
         // For active patterns, we need to search for both the function and its cases
-        // because FCS doesn't always find cross-file references correctly
+        // because FCS doesn't always find cross-file references correctly.
+        // The function symbol finds function-call style usages, the case symbol finds match-case usages.
         let symbolsToSearch =
           match symbol with
           | :? FSharpActivePatternCase as apCase ->
-            // At a usage site: we have a case, also search for the declaring function
-            // e.g., for case `ParseInt` in `(|ParseInt|_|)`, also search for the function
+            // At a case symbol (either at declaration or usage)
+            // Search for both the case (for match-case usages) AND the function (for function-call usages)
             match apCase.Group.DeclaringEntity with
             | Some entity ->
-              // Search for the function using the pattern "|CaseName|" to match within the full pattern name
-              // e.g., for case "ParseInt", search for function containing "|ParseInt|"
               let apcSearchString = $"|{apCase.DisplayName}|"
 
               let declaringMember =
@@ -868,28 +867,24 @@ module Commands =
               | None -> [ symbol ]
             | None -> [ symbol ]
           | :? FSharpMemberOrFunctionOrValue as mfv when mfv.IsActivePattern ->
-            // At a declaration site: this is an active pattern function
-            // We need to search for both the function AND its individual cases to find all usages
+            // At an active pattern function symbol - search for both the function AND its cases
             // FCS finds function-call style usages (e.g., `(|ParseFloat|_|) x`) for the function
             // FCS finds match-case style usages (e.g., `| ParseFloat x ->`) for the cases
             match mfv.DeclaringEntity with
             | Some entity ->
-              // Get all active pattern cases in the entity and find those matching this function's cases
               let functionCases =
                 try
                   entity.ActivePatternCases
                   |> Seq.filter (fun apc ->
-                    // Match case to function by checking if the function's display name contains the case name
-                    // e.g., for function "|ParseFloat|_|", case would be "ParseFloat"
                     mfv.DisplayName.Contains($"|{apc.DisplayName}|", System.StringComparison.OrdinalIgnoreCase))
                   |> Seq.map (fun apc -> apc :> FSharpSymbol)
                   |> Seq.toList
                 with _ ->
                   []
+
               symbol :: functionCases
             | None -> [ symbol ]
-          | :? FSharpMemberOrFunctionOrValue ->
-            [ symbol ]
+          | :? FSharpMemberOrFunctionOrValue -> [ symbol ]
           | _ -> [ symbol ]
 
         /// Adds References of `symbol` in `file` to `dict`
@@ -910,9 +905,22 @@ module Commands =
                 allReferences
                 |> Array.concat
                 // Deduplicate - when searching for multiple symbols (e.g., active pattern function + cases),
-                // they may return duplicate ranges at the same location
-                // Use distinctBy with a tuple key since Range objects may not be structurally equal
-                |> Array.distinctBy (fun r -> r.StartLine, r.StartColumn, r.EndLine, r.EndColumn)
+                // they may return overlapping ranges at the same location.
+                // For example, at an active pattern declaration we might find both:
+                //   `|IsOneOfChoice|_|` (function symbol) and `IsOneOfChoice` (case symbol)
+                // Keep only the outermost (longest) range when ranges overlap or are contained within each other.
+                |> Array.groupBy (fun r -> r.StartLine)
+                |> Array.collect (fun (_, rangesOnLine) ->
+                  // For ranges on the same line, filter out those that are contained within another
+                  rangesOnLine
+                  |> Array.filter (fun r ->
+                    rangesOnLine
+                    |> Array.exists (fun other ->
+                      // Check if 'other' strictly contains 'r' (r is nested inside other)
+                      other.StartColumn <= r.StartColumn
+                      && other.EndColumn >= r.EndColumn
+                      && (other.StartColumn < r.StartColumn || other.EndColumn > r.EndColumn))
+                    |> not))
                 |> Array.toSeq
 
               let references =
@@ -1035,6 +1043,13 @@ module Commands =
           else
             result.Add(k, v)
 
+      // Deduplicate across all symbol searches - when clicking on an active pattern,
+      // TryGetSymbolUses may return both the function and case symbol, leading to duplicates
+      for KeyValue(k, v) in result do
+        result.[k] <-
+          v
+          |> Array.distinctBy (fun r -> r.StartLine, r.StartColumn, r.EndLine, r.EndColumn)
+
       return result
     }
 

test/FsAutoComplete.Tests.Lsp/FindReferencesTests.fs

@@ -371,6 +371,109 @@ let private solutionTests state =
                 Expect.locationsEqual getSource false refs expected
               }) ]) ])
 
+/// Tests for ActivePatternProject - tests cross-file active pattern references
+let private activePatternProjectTests state =
+
+  let marker = "//>"
+
+  let readReferences path =
+    let lines = File.ReadAllLines path
+    let refs = Dictionary<string, IList<Location>>()
+
+    for i in 0 .. (lines.Length - 1) do
+      let line = lines[i].TrimStart()
+
+      if line.StartsWith(marker, StringComparison.Ordinal) then
+        let l = line.Substring(marker.Length).Trim()
+        let splits = l.Split([| ' ' |], 2)
+        let mark = splits[0]
+
+        let range =
+          let col = line.IndexOf(mark, StringComparison.Ordinal)
+          let length = mark.Length
+          let line = i - 1 // marker is line AFTER actual range
+
+          { Start =
+              { Line = uint32 line
+                Character = uint32 col }
+            End =
+              { Line = uint32 line
+                Character = uint32 (col + length) } }
+
+        let loc =
+          { Uri = path |> normalizePath |> Path.LocalPathToUri
+            Range = range }
+
+        let name = if splits.Length > 1 then splits[1] else ""
+
+        if not (refs.ContainsKey name) then
+          refs[name] <- List<_>()
+
+        let existing = refs[name]
+        existing.Add loc |> ignore
+
+    refs
+
+  let readAllReferences dir =
+    let files = Directory.GetFiles(dir, "*.fs", SearchOption.AllDirectories)
+
+    files
+    |> Seq.map readReferences
+    |> Seq.map (fun dict -> dict |> Seq.map (fun kvp -> kvp.Key, kvp.Value))
+    |> Seq.collect id
+    |> Seq.groupBy fst
+    |> Seq.map (fun (name, locs) -> (name, locs |> Seq.map snd |> Seq.collect id |> Seq.toArray))
+    |> Seq.map (fun (name, locs) -> {| Name = name; Locations = locs |})
+    |> Seq.toArray
+
+
+  let path =
+    Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "FindReferences", "ActivePatternProject")
+
+  serverTestList "ActivePatternProject" state defaultConfigDto (Some path) (fun server ->
+    [
+      let mainDoc = "Patterns.fs"
+
+      documentTestList "inside Patterns.fs" server (Server.openDocument mainDoc) (fun doc ->
+        [ let refs = readAllReferences path
+
+          for r in refs do
+            testCaseAsync
+              r.Name
+              (async {
+                let! (doc, _) = doc
+
+                let cursor =
+                  let cursor =
+                    r.Locations
+                    |> Seq.filter (fun l -> l.Uri = doc.Uri)
+                    |> Seq.minBy (fun l -> l.Range.Start)
+
+                  cursor.Range.Start
+
+                let request: ReferenceParams =
+                  { TextDocument = doc.TextDocumentIdentifier
+                    Position = cursor
+                    Context = { IncludeDeclaration = true }
+                    WorkDoneToken = None
+                    PartialResultToken = None }
+
+                let! refs = doc.Server.Server.TextDocumentReferences request
+
+                let refs =
+                  refs
+                  |> Flip.Expect.wantOk "Should not fail"
+                  |> Flip.Expect.wantSome "Should return references"
+
+                let expected = r.Locations
+
+                let getSource uri =
+                  let path = Path.FileUriToLocalPath uri
+                  File.ReadAllText path
+
+                Expect.locationsEqual getSource false refs expected
+              }) ]) ])
+
 /// multiple untitled files (-> all docs are unrelated)
 /// -> Tests for external symbols (-> over all docs) & symbol just in current doc (-> no matches in other unrelated docs)
 let private untitledTests state =
@@ -898,6 +1001,67 @@ let private rangeTests state =
           | MyModule.$<Regex>$ @"\d+" v -> v
           | _ -> ""
         """
+      testCaseAsync "can get range of inline struct partial Active Pattern - full pattern"
+      <|
+      // Inline struct partial active pattern - clicking on the full pattern (|StrStartsWith|_|)
+      // Tests that both function-call style usages like `(|StrStartsWith|_|) "hello" "world"`
+      // and match-case style usages like `| StrStartsWith "hello" ->` are found.
+      checkRanges
+        server
+        """
+        module MyModule =
+          [<return: Struct>]
+          let inline ($D<|StrSta$0rtsWith|_|>D$) (prefix: string) (item: string) =
+            if item.StartsWith prefix then ValueSome () else ValueNone
+
+          // Function-call style usage in same module
+          let testDirect = ($<|StrStartsWith|_|>$) "hello" "hello world"
+
+        open MyModule
+        // Function-call style usage with open
+        let _ = ($<|StrStartsWith|_|>$) "hello" "hello world"
+        // Function-call style usage with qualified name
+        let _ = MyModule.($<|StrStartsWith|_|>$) "hello" "hello world"
+        // Match-case style usage
+        let _ =
+          match "hello world" with
+          | StrStartsWith "hello" -> true
+          | _ -> false
+        let _ =
+          match "hello world" with
+          | MyModule.StrStartsWith "hello" -> true
+          | _ -> false
+        """
+      testCaseAsync "can get range of inline struct partial Active Pattern case"
+      <|
+      // When clicking on the case name in an inline struct partial active pattern
+      // Only match-case style usages are found for the case (FCS limitation)
+      // Function-call style usages use the full pattern, not individual cases
+      checkRanges
+        server
+        """
+        module MyModule =
+          [<return: Struct>]
+          let inline (|$D<StrStartsWith>D$|_|) (prefix: string) (item: string) =
+            if item.StartsWith prefix then ValueSome () else ValueNone
+
+          // Function-call style usage - NOT marked because FCS doesn't find it for case symbols
+          let testDirect = (|StrStartsWith|_|) "hello" "hello world"
+
+        open MyModule
+        // Function-call style usages - NOT marked
+        let _ = (|StrStartsWith|_|) "hello" "hello world"
+        let _ = MyModule.(|StrStartsWith|_|) "hello" "hello world"
+        // Match-case style usages - these ARE found
+        let _ =
+          match "hello world" with
+          | $<StrSta$0rtsWith>$ "hello" -> true
+          | _ -> false
+        let _ =
+          match "hello world" with
+          | MyModule.$<StrStartsWith>$ "hello" -> true
+          | _ -> false
+        """
       testCaseAsync "can get range of type for static function call"
       <| checkRanges
         server
@@ -922,6 +1086,7 @@ let tests state =
     "Find All References tests"
     [ scriptTests state
       solutionTests state
+      activePatternProjectTests state
       untitledTests state
       rangeTests state ]
 

test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/Module1.fs

@@ -86,3 +86,31 @@ module Module1 =
         match n with
         | DivisibleByStruct 3 result -> ValueSome result
         | _ -> ValueNone
+
+    // ============================================
+    // INLINE GENERIC ACTIVE PATTERNS
+    // ============================================
+
+    // Using IsOneOfChoice - inline generic struct parameterized pattern
+    let checkIfStartsWithPrefix input =
+        match input with
+        | IsOneOfChoice ((|StrStartsWith|_|), ["hello"; "hi"; "hey"]) -> true
+//>       ^^^^^^^^^^^^^ IsOneOfChoice
+        | _ -> false
+
+    // Using IsOneOfChoice as a function
+    let checkPrefixDirect input =
+        (|IsOneOfChoice|_|) ((|StrStartsWith|_|), ["hello"; "hi"]) input
+//>      ^^^^^^^^^^^^^^^^^ IsOneOfChoice
+
+    // Using StrStartsWithOneOf which uses IsOneOfChoice internally
+    let checkGreeting input =
+        match input with
+        | StrStartsWithOneOf ["hello"; "hi"; "hey"] -> "greeting"
+        | _ -> "not a greeting"
+
+    // Using StrStartsWith directly
+    let startsWithHello input =
+        match input with
+        | StrStartsWith "hello" -> true
+        | _ -> false

test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/Module2.fs

@@ -86,3 +86,24 @@ module Module2 =
         | Patterns.DivisibleByStruct 3 _ -> "divisible by 3 (struct)"
         | Patterns.DivisibleByStruct 5 _ -> "divisible by 5 (struct)"
         | _ -> "not divisible by 2, 3, or 5"
+
+    // ============================================
+    // INLINE GENERIC ACTIVE PATTERNS (qualified access)
+    // ============================================
+
+    // Using IsOneOfChoice as a function with qualified access
+    let checkPrefixQualified input =
+        Patterns.(|IsOneOfChoice|_|) (Patterns.(|StrStartsWith|_|), ["hello"; "hi"]) input
+//>               ^^^^^^^^^^^^^^^^^ IsOneOfChoice
+
+    // Using StrStartsWithOneOf with qualified access
+    let checkGreetingQualified input =
+        match input with
+        | Patterns.StrStartsWithOneOf ["hello"; "hi"; "hey"] -> "greeting"
+        | _ -> "not a greeting"
+
+    // Using StrStartsWith with qualified access
+    let startsWithHelloQualified input =
+        match input with
+        | Patterns.StrStartsWith "hello" -> true
+        | _ -> false

test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/Patterns.fs

@@ -1,5 +1,13 @@
 namespace ActivePatternProject
 
+module Seq =
+    let inline tryPickV chooser (source: seq<'T>) =
+        use e = source.GetEnumerator()
+        let mutable res = ValueNone
+        while (ValueOption.isNone res && e.MoveNext()) do
+            res <- chooser e.Current
+        res
+
 /// Module containing various active pattern definitions
 module Patterns =
 
@@ -83,3 +91,19 @@ module Patterns =
     let inline (|DivisibleByStruct|_|) divisor value =
         if value % divisor = 0 then ValueSome(value / divisor)
         else ValueNone
+
+
+    [<return: Struct>]
+    let inline (|IsOneOfChoice|_|) (chooser: 'a -> 'b -> 'c voption, values : 'a seq) (item : 'b) =
+//>             ^^^^^^^^^^^^^^^^^ IsOneOfChoice
+        values |> Seq.tryPickV (fun x -> chooser x item)
+
+    [<return: Struct>]
+    let inline (|StrStartsWith|_|) (value : string) (item : string) =
+        if item.StartsWith value then ValueSome ()
+        else ValueNone
+
+    [<return: Struct>]
+    let inline (|StrStartsWithOneOf|_|) (values : string seq) (item : string) =
+        (|IsOneOfChoice|_|) ((|StrStartsWith|_|), values) item
+//>      ^^^^^^^^^^^^^^^^^ IsOneOfChoice

test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/Solution/B/MyModule3.fs

@@ -27,9 +27,23 @@ let classifyInModule3 n =
     | Even -> "even"
     | Odd -> "odd"
 
-// Partial active pattern usage
+// Partial active pattern usage (cross-file)
+// NOTE: No markers here - see WorkingModule.fs for explanation of FCS limitations
 let _ = (|ParseInt|_|) "999"
 let parseInModule3 input =
     match input with
     | ParseInt n -> Some n
-    | _ -> None
+    | _ -> None
+
+// ============================================
+// INLINE ACTIVE PATTERN CROSS-FILE USAGES
+// NOTE: No markers - see B/WorkingModule.fs for explanation of FCS limitations
+// ============================================
+
+// Function-call style usage cross-file
+let _ = (|StrPrefix|_|) "hi" "hi there"
+// Match-case style usage cross-file
+let checkPrefix input =
+    match input with
+    | StrPrefix "test" -> true
+    | _ -> false