diff --git a/src/FsAutoComplete.Core/Commands.fs b/src/FsAutoComplete.Core/Commands.fs index c4af5c608..bc14709a7 100644 --- a/src/FsAutoComplete.Core/Commands.fs +++ b/src/FsAutoComplete.Core/Commands.fs @@ -92,6 +92,192 @@ module Commands = let fantomasLogger = LogProvider.getLoggerByName "Fantomas" let commandsLogger = LogProvider.getLoggerByName "Commands" + /// Extracts the case name(s) from an active pattern name string. + /// For partial patterns like "|CaseName|_|" returns "CaseName" + /// For full patterns like "|Even|Odd|" returns the first case name + let extractActivePatternCaseName (name: string) : string = + let parts = name.Split('|') |> Array.filter (fun s -> s <> "" && s <> "_") + if parts.Length > 0 then parts.[0] else name + + /// Extracts all case names from an active pattern display name. + /// For "(|ParseInt|_|)" returns ["ParseInt"] + /// For "(|Even|Odd|)" returns ["Even"; "Odd"] + let extractActivePatternCaseNames (displayName: string) : string list = + displayName.TrimStart('|', '(').TrimEnd('|', '_', ')').Split('|') + |> Array.filter (fun s -> not (String.IsNullOrWhiteSpace(s))) + |> Array.toList + + /// Finds usages of partial active pattern cases by walking the AST. + /// + /// Returns syntactic ranges from the AST where the specified case names appear in pattern matches. + /// For qualified identifiers (e.g., `MyModule.ParseInt`), returns the full qualified range to match FCS behavior. + /// Recursively traverses all pattern forms, including nested and composite patterns (tuples, lists, or/and/as patterns, etc.). + /// + /// Note: Only syntactic (AST) ranges are returned; semantic information is not considered. + let findPartialActivePatternCaseUsages (caseNames: string list) (parseResults: FSharpParseFileResults) : range list = + let rec walkPat (pat: SynPat) = + seq { + match pat with + | SynPat.LongIdent(longDotId = synLongIdent; argPats = args) -> + // Check if this is a potential case usage + match synLongIdent with + | SynLongIdent(id = idents) -> + match idents with + | [] -> () + | [ singleIdent ] when List.contains singleIdent.idText caseNames -> + // Single identifier that matches a case name + yield singleIdent.idRange + | multipleIdents -> + // Qualified identifier (e.g., MyModule.ParseInt) + let lastIdent = List.last multipleIdents + + if List.contains lastIdent.idText caseNames then + // Return the full qualified range to match what FCS returns + yield synLongIdent.Range + + // Recursively check arguments + match args with + | SynArgPats.Pats pats -> yield! List.collect (walkPat >> Seq.toList) pats + | SynArgPats.NamePatPairs(pats = pairs; range = _) -> + yield! List.collect (fun (NamePatPairField(pat = pat)) -> walkPat pat |> Seq.toList) pairs + + | SynPat.Paren(pat, _) -> yield! walkPat pat + | SynPat.Tuple(elementPats = pats) -> yield! List.collect (walkPat >> Seq.toList) pats + | SynPat.ArrayOrList(_, pats, _) -> yield! List.collect (walkPat >> Seq.toList) pats + | SynPat.Ands(pats, _) -> yield! List.collect (walkPat >> Seq.toList) pats + | SynPat.Or(lhsPat = pat1; rhsPat = pat2) -> + yield! walkPat pat1 + yield! walkPat pat2 + | SynPat.As(lpat, rpat, _) -> + yield! walkPat lpat + yield! walkPat rpat + | SynPat.Typed(pat, _, _) -> yield! walkPat pat + | SynPat.Attrib(pat, _, _) -> yield! walkPat pat + | SynPat.ListCons(lpat, rpat, _, _) -> + yield! walkPat lpat + yield! walkPat rpat + | _ -> () + } + + let rec walkExpr (expr: SynExpr) = + let walkMatchClauses clauses = + seq { + for clause in clauses do + match clause with + | SynMatchClause(pat = pat; resultExpr = resultExpr) -> + yield! walkPat pat + yield! walkExpr resultExpr + } + + seq { + match expr with + | SynExpr.Match(expr = matchExpr; clauses = clauses) -> + yield! walkExpr matchExpr + yield! walkMatchClauses clauses + | SynExpr.MatchBang(expr = matchExpr; clauses = clauses) -> + yield! walkExpr matchExpr + yield! walkMatchClauses clauses + | SynExpr.TryWith(tryExpr = tryExpr; withCases = clauses) -> + yield! walkExpr tryExpr + yield! walkMatchClauses clauses + | SynExpr.MatchLambda(matchClauses = clauses) -> yield! walkMatchClauses clauses + | SynExpr.Lambda(args = args; body = body) -> + match args with + | SynSimplePats.SimplePats(pats = pats) -> + for spat in pats do + match spat with + | SynSimplePat.Typed(pat, _, _) + | SynSimplePat.Attrib(pat, _, _) -> + match pat with + | SynSimplePat.Id(ident, _, _, _, _, _) when List.contains ident.idText caseNames -> yield ident.idRange + | _ -> () + | SynSimplePat.Id(ident, _, _, _, _, _) when List.contains ident.idText caseNames -> yield ident.idRange + | _ -> () + + yield! walkExpr body + // Continue walking nested expressions + | SynExpr.App(funcExpr = e1; argExpr = e2) -> + yield! walkExpr e1 + yield! walkExpr e2 + | SynExpr.LetOrUse(bindings = bindings; body = body) -> + // Walk the binding expressions + for binding in bindings do + match binding with + | SynBinding(expr = expr) -> yield! walkExpr expr + + // Walk the body + yield! walkExpr body + | SynExpr.Sequential(expr1 = e1; expr2 = e2) -> + yield! walkExpr e1 + yield! walkExpr e2 + | SynExpr.IfThenElse(ifExpr = e1; thenExpr = e2; elseExpr = e3opt) -> + yield! walkExpr e1 + yield! walkExpr e2 + + match e3opt with + | Some e3 -> yield! walkExpr e3 + | None -> () + | SynExpr.Paren(expr, _, _, _) -> yield! walkExpr expr + | SynExpr.Typed(expr = expr) -> yield! walkExpr expr + // Computation expressions (seq, async, task, etc.) + | SynExpr.ComputationExpr(expr = expr) -> yield! walkExpr expr + // Array or list expressions + | SynExpr.ArrayOrList(exprs = exprs) -> yield! List.collect (walkExpr >> Seq.toList) exprs + | SynExpr.ArrayOrListComputed(expr = expr) -> yield! walkExpr expr + // For loops + | SynExpr.For(doBody = body) -> yield! walkExpr body + | SynExpr.ForEach(enumExpr = enumExpr; bodyExpr = body) -> + yield! walkExpr enumExpr + yield! walkExpr body + // While loop + | SynExpr.While(whileExpr = whileExpr; doExpr = doExpr) -> + yield! walkExpr whileExpr + yield! walkExpr doExpr + // Tuples + | SynExpr.Tuple(exprs = exprs) -> yield! List.collect (walkExpr >> Seq.toList) exprs + // Record expressions + | SynExpr.Record(copyInfo = copyInfo; recordFields = fields) -> + match copyInfo with + | Some(expr, _) -> yield! walkExpr expr + | None -> () + + for (SynExprRecordField(expr = exprOpt)) in fields do + match exprOpt with + | Some expr -> yield! walkExpr expr + | None -> () + | _ -> () + } + + let rec walkDecl (decl: SynModuleDecl) = + seq { + match decl with + | SynModuleDecl.Let(bindings = bindings) -> + for binding in bindings do + match binding with + | SynBinding(expr = expr) -> yield! walkExpr expr + | SynModuleDecl.Expr(expr, _) -> yield! walkExpr expr + | SynModuleDecl.NestedModule(decls = decls) -> yield! List.collect (walkDecl >> Seq.toList) decls + | SynModuleDecl.Types(typeDefs, _) -> + for typeDef in typeDefs do + match typeDef with + | SynTypeDefn(members = members) -> + for memb in members do + match memb with + | SynMemberDefn.Member(SynBinding(expr = expr), _) -> yield! walkExpr expr + | SynMemberDefn.LetBindings(bindings, _, _, _) -> + for SynBinding(expr = expr) in bindings do + yield! walkExpr expr + | _ -> () + | _ -> () + } + + match parseResults.ParseTree with + | ParsedInput.ImplFile(ParsedImplFileInput(contents = modules)) -> + modules + |> List.collect (fun (SynModuleOrNamespace(decls = decls)) -> decls |> List.collect (walkDecl >> Seq.toList)) + |> List.distinctBy (fun r -> r.Start, r.End) + | _ -> [] + let addFile (fsprojPath: string) fileVirtPath = async { try @@ -750,7 +936,25 @@ module Commands = asyncResult { let symbol = symbolUse.Symbol - let symbolNameCore = symbol.DisplayNameCore + let symbolNameCore = + match symbol with + | :? FSharpActivePatternCase as apc -> + // For active pattern cases, extract just the case name without bars + // apc.Name may include bars like "|LetterOrDigit|_|" for partial patterns + if apc.Name.StartsWith("|") then + extractActivePatternCaseName apc.Name + else + apc.Name + | :? FSharpMemberOrFunctionOrValue as mfv when mfv.IsActivePattern -> + // For active pattern functions, extract just the case name for partial patterns + // For full patterns like "(|Even|Odd|)", use DisplayNameCore as-is + let displayName = symbol.DisplayNameCore + + if displayName.Contains("|_|") then + extractActivePatternCaseName displayName + else + displayName + | _ -> symbol.DisplayNameCore let tryAdjustRanges (text: IFSACSourceText, ranges: seq) = let ranges = ranges |> Seq.map (fun range -> range.NormalizeDriveLetterCasing()) @@ -779,13 +983,73 @@ module Commands = let! ct = Async.CancellationToken let symbolUses = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct) - let symbolUses: _ seq = - if includeDeclarations then - symbolUses - else - symbolUses |> Seq.filter (fun u -> not u.IsFromDefinition) - - let ranges = symbolUses |> Seq.map (fun u -> u.Range) + let (symbolUses: _ seq), additionalRangesForPartialPatterns = + let baseFiltered: _ seq = + if includeDeclarations then + symbolUses + else + symbolUses |> Seq.filter (fun u -> not u.IsFromDefinition) + + // For Active Pattern Cases, FCS returns all cases in the pattern, not just the specific one + // We need to filter to only the symbol that matches our query + // BUT: if querying from the Active Pattern declaration itself (FSharpMemberOrFunctionOrValue), + // we also want to find the case usages + match symbolUse.Symbol with + | :? FSharpActivePatternCase as apc -> + // Querying from a specific case - filter to just that case + let filtered = + baseFiltered + |> Seq.filter (fun u -> + match u.Symbol with + | :? FSharpActivePatternCase as foundApc -> foundApc.Name = apc.Name + | _ -> false) + + // For partial active patterns in .fsx files, FCS may not return case usages + // We walk the AST and deduplicate with what FCS found + let isPartialPattern = apc.Group.IsTotal |> not + + let caseUsageRanges = + if isPartialPattern then + findPartialActivePatternCaseUsages [ apc.Name ] tyRes.GetParseResults + else + // Complete patterns - FCS handles these correctly + [] + + filtered, caseUsageRanges + | :? FSharpMemberOrFunctionOrValue as mfv when + mfv.IsActivePattern + || (mfv.DisplayName.StartsWith("(|") && mfv.DisplayName.EndsWith("|)")) + -> + // Querying from the active pattern function declaration + // For partial active patterns like (|ParseInt|_|), include case usages in match expressions + // For complete active patterns like (|Even|Odd|), only return the function declaration + // Note: IsActivePattern is true for direct definitions, but let-bound values need DisplayName check + + let patternDisplayName = mfv.DisplayName + // DisplayName includes parens: "(|ParseInt|_|)" so we need to check for "|_|)" not just "|_|" + let isPartialActivePattern = patternDisplayName.Contains("|_|") + + if not isPartialActivePattern then + // For complete patterns, only return the pattern function declaration + baseFiltered, [] + else + // For partial patterns, find case usages by walking the AST + let caseNames = extractActivePatternCaseNames patternDisplayName + + let caseUsageRanges = + findPartialActivePatternCaseUsages caseNames tyRes.GetParseResults + + // For partial patterns, FCS doesn't include case usages in pattern matches + // We found them by walking the AST, so we return them as additional ranges + baseFiltered, caseUsageRanges + | _ -> baseFiltered, [] + + let ranges = + let baseRanges = symbolUses |> Seq.map (fun u -> u.Range) + // Add any additional ranges we found from walking the AST for partial active patterns + // Deduplicate based on range start and end positions + Seq.append baseRanges (Seq.ofList additionalRangesForPartialPatterns) + |> Seq.distinctBy (fun r -> r.Start, r.End) // Note: tryAdjustRanges is designed to only be able to fail iff `errorOnFailureToFixRange` is `true` let! ranges = tryAdjustRanges (text, ranges) let ranges = dict [ (text.FileName, Seq.toArray ranges) ] diff --git a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs index 4a510ff37..770a4a848 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs @@ -28,6 +28,7 @@ open FSharp.Compiler.EditorServices open FSharp.Data.Adaptive open Ionide.ProjInfo open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.Symbols open FsAutoComplete.UnionPatternMatchCaseGenerator open System.Collections.Concurrent open System.Text.RegularExpressions @@ -1172,10 +1173,9 @@ type AdaptiveState binlogConfig |> addAValLogging (fun () -> logger.info (Log.setMessage "Loading projects because binlogConfig change")) - let! projects = - // need to bind to a single value to keep the threadpool from being exhausted as LoadingProjects can be a long running operation - // and when other adaptive values await on this, the scheduler won't block those other tasks - loadProjects loader binlogConfig projects |> AMap.toAVal + // need to bind to a single value to keep the threadpool from being exhausted as LoadingProjects can be a long running operation + // and when other adaptive values await on this, the scheduler won't block those other tasks + let! projects = loadProjects loader binlogConfig projects |> AMap.toAVal and! checker = checker checker.ClearCaches() @@ -2173,21 +2173,67 @@ type AdaptiveState async { let checker = checker |> AVal.force - if File.Exists(UMX.untag file) then - match project with - | CompilerProjectOption.TransparentCompiler snap -> - return! checker.FindReferencesForSymbolInFile(file, snap, symbol) - // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files - | CompilerProjectOption.BackgroundCompiler opts -> - return! checker.FindReferencesForSymbolInFile(file, opts, symbol) - else - // untitled script files - match! forceGetOpenFileTypeCheckResultsStale file with - | Error _ -> return Seq.empty - | Ok tyRes -> - let! ct = Async.CancellationToken - let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct) - return usages |> Seq.map (fun u -> u.Range) + let! baseRanges = + if File.Exists(UMX.untag file) then + match project with + | CompilerProjectOption.TransparentCompiler snap -> + checker.FindReferencesForSymbolInFile(file, snap, symbol) + // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files + | CompilerProjectOption.BackgroundCompiler opts -> checker.FindReferencesForSymbolInFile(file, opts, symbol) + else + // untitled script files + async { + match! forceGetOpenFileTypeCheckResultsStale file with + | Error _ -> return Seq.empty + | Ok tyRes -> + let! ct = Async.CancellationToken + let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct) + return usages |> Seq.map (fun u -> u.Range) + } + + // For partial active patterns, also find case usages in match expressions + match (symbol: FSharpSymbol) with + | :? FSharpMemberOrFunctionOrValue as mfv when + mfv.IsActivePattern + || (mfv.DisplayName.StartsWith("(|") && mfv.DisplayName.EndsWith("|)")) + -> + let patternDisplayName = mfv.DisplayName + // Check if it's a partial active pattern (contains |_|) + // Note: IsActivePattern is true for direct definitions, but let-bound values need DisplayName check + let isPartialActivePattern = patternDisplayName.Contains("|_|") + + if isPartialActivePattern then + // Get parse results for this file to walk the AST + match! forceGetOpenFileTypeCheckResultsStale file with + | Error _ -> return baseRanges + | Ok tyRes -> + let caseNames = Commands.extractActivePatternCaseNames patternDisplayName + + let caseUsageRanges = + Commands.findPartialActivePatternCaseUsages caseNames tyRes.GetParseResults + + return Seq.append baseRanges caseUsageRanges + else + return baseRanges + | :? FSharpActivePatternCase as apc -> + // When user clicks on a specific active pattern case usage (e.g., LetterOrDigit in a match expression), + // FCS returns all usages correctly in project files, but may not in .fsx files for partial patterns + let isPartialPattern = apc.Group.IsTotal |> not + + if isPartialPattern then + match! forceGetOpenFileTypeCheckResultsStale file with + | Error _ -> return baseRanges + | Ok tyRes -> + let caseUsageRanges = + Commands.findPartialActivePatternCaseUsages [ apc.Name ] tyRes.GetParseResults + + // Combine and deduplicate + return + Seq.append baseRanges caseUsageRanges + |> Seq.distinctBy (fun r -> r.Start, r.End) + else + return baseRanges + | _ -> return baseRanges } let tryGetProjectOptionsForFsproj (file: string) = diff --git a/test/FsAutoComplete.Tests.Lsp/FindReferencesTests.fs b/test/FsAutoComplete.Tests.Lsp/FindReferencesTests.fs index 7b352af74..ea6c355f8 100644 --- a/test/FsAutoComplete.Tests.Lsp/FindReferencesTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/FindReferencesTests.fs @@ -460,15 +460,51 @@ let private untitledTests state = }) ]) -/// Tests to check references span the correct range. For example: `Delay`, not `Task.Delay` -let private rangeTests state = - let checkRanges server sourceWithCursors = - async { - let (source, cursors) = sourceWithCursors |> extractRanges - let! (doc, diags) = server |> Server.createUntitledDocument source - - use doc = doc - Expect.hasLength diags 0 "There should be no diags" +let private checkRanges server sourceWithCursors = + async { + let (source, cursors) = sourceWithCursors |> extractRanges + let! (doc, diags) = server |> Server.createUntitledDocument source + + use doc = doc + Expect.hasLength diags 0 "There should be no diags" + + let request: ReferenceParams = + { TextDocument = doc.TextDocumentIdentifier + Position = cursors.Cursor.Value + 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" + |> Array.sortBy (fun l -> l.Range.Start) + + Expect.all refs (fun r -> r.Uri = doc.Uri) "there should only be references in current doc" + + let expected = + Array.append cursors.Declarations cursors.Usages + |> Array.sortBy (fun r -> r.Start) + |> Array.map (mkLocation doc) + + // Expect.sequenceEqual refs expected "Should find all refs with correct range" + if refs <> expected then + Expect.equal (markRanges source refs) (markRanges source expected) "Should find correct references" + } + +let private checkRangesScript server sourceWithCursors = + async { + let (source, cursors) = sourceWithCursors |> extractRanges + let tempFile = Path.GetTempFileName() + let scriptFile = Path.ChangeExtension(tempFile, ".fsx") + File.WriteAllText(scriptFile, source) + + try + let! (doc, diags) = server |> Server.openDocument scriptFile + Expect.isEmpty diags "There should be no diagnostics in script file" let request: ReferenceParams = { TextDocument = doc.TextDocumentIdentifier @@ -480,23 +516,27 @@ let private rangeTests state = let! refs = doc.Server.Server.TextDocumentReferences request let refs = - refs - |> Flip.Expect.wantOk "Should not fail" - |> Flip.Expect.wantSome "Should return references" - |> Array.sortBy (fun l -> l.Range.Start) + refs + |> Flip.Expect.wantOk "Should not fail" + |> Flip.Expect.wantSome "Should return references" + |> Array.sortBy (fun l -> l.Range.Start) Expect.all refs (fun r -> r.Uri = doc.Uri) "there should only be references in current doc" let expected = Array.append cursors.Declarations cursors.Usages |> Array.sortBy (fun r -> r.Start) - |> Array.map (mkLocation doc) - // Expect.sequenceEqual refs expected "Should find all refs with correct range" - if refs <> expected then - Expect.equal (markRanges source refs) (markRanges source expected) "Should find correct references" - } + let refs = refs |> Array.map (fun l -> l.Range) + Expect.equal refs expected "Should find correct references" + finally + try File.Delete(scriptFile) with _ -> () + try File.Delete(tempFile) with _ -> () + } + +/// Tests to check references span the correct range. For example: `Delay`, not `Task.Delay` +let private rangeTests state = serverTestList "range" state defaultConfigDto None (fun server -> [ testCaseAsync "can get range of variable" <| checkRanges @@ -626,15 +666,273 @@ let private rangeTests state = .$$ .Delay TimeSpan.MaxValue } + """ + testCaseAsync "can find references in example2.fsx (script)" + <| checkRangesScript + server + """ +module FsAutoComplete.CodeFix.RemoveUnnecessaryParentheses + +open System + +let title = "Remove unnecessary parentheses" + +[] +module private Patterns = + let inline toPat f x = if f x then ValueSome() else ValueNone + + /// Starts with //. + [] + let (|StartsWithSingleLineComment|_|) (s: string) = + if s.AsSpan().TrimStart(' ').StartsWith("//".AsSpan()) then + ValueSome StartsWithSingleLineComment + else + ValueNone + + /// Starts with match, e.g., + /// + /// (match … with + /// | … -> …) + [] + let (|StartsWithMatch|_|) (s: string) = + let s = s.AsSpan().TrimStart ' ' + + if s.StartsWith("match".AsSpan()) && (s.Length = 5 || s[5] = ' ') then + ValueSome StartsWithMatch + else + ValueNone + + [] + module Char = + [] + let inline (|$DD$|_|) c = toPat Char.IsLetterOrDigit c + + [] + let inline (|Punctuation|_|) c = toPat Char.IsPunctuation c + + [] + let inline (|Symbol|_|) c = toPat Char.IsSymbol c + +/// A codefix that removes unnecessary parentheses from the source. +let fix (getFileLines: obj) : obj = + async { + let (|ShouldPutSpaceBefore|_|) (s: string) = + match s with + | StartsWithMatch -> None + | _ -> + // ……(……) + // ↑↑ ↑ + (Some ' ', Some ' ') + ||> Option.map2 (fun twoBefore oneBefore -> + match twoBefore, oneBefore, s[0] with + | _, _, ('\n' | '\r') -> None + | '[', '|', (Punctuation | $$) -> None + | _, '[', '<' -> Some ShouldPutSpaceBefore + | _, ('(' | '[' | '{'), _ -> None + | _, '>', _ -> Some ShouldPutSpaceBefore + | ' ', '=', _ -> Some ShouldPutSpaceBefore + | _, '=', ('(' | '[' | '{') -> None + | _, '=', (Punctuation | Symbol) -> Some ShouldPutSpaceBefore + | _, $$, '(' -> None + | _, ($$ | '`'), _ -> Some ShouldPutSpaceBefore + | _, (Punctuation | Symbol), (Punctuation | Symbol) -> Some ShouldPutSpaceBefore + | _ -> None) + |> Option.flatten + + () + + return () + } + """ + testCaseAsync "can get range of partial Active Pattern definition and usages" + <| checkRanges + server + """ + module MyModule = + let (|$DD$|_|) (s: string) = + match System.Int32.TryParse s with + | true, i -> Some i + | _ -> None + + open MyModule + let test input = + match input with + | $$ i -> printfn "Got %d" i + | _ -> printfn "Not an int" + + let test2 input = + match input with + | MyModule.$$ i -> i + | _ -> 0 + """ + testCaseAsync "can get range of partial Active Pattern with nested matches" + <| checkRanges + server + """ + let (|$DD$|_|) n = if n > 0 then Some n else None + let (|Negative|_|) n = if n < 0 then Some n else None + + let classify n = + match n with + | $$ p -> + match p with + | $$ _ -> "still positive" + | _ -> "?" + | Negative _ -> "negative" + | _ -> "zero" + """ + testCaseAsync "can get range of partial Active Pattern used in Or pattern" + <| checkRanges + server + """ + let (|$DD$|_|) n = if n % 2 = 0 then Some() else None + let (|DivisibleBy3|_|) n = if n % 3 = 0 then Some() else None + + let test n = + match n with + | $$ | DivisibleBy3 -> "divisible by 2 or 3" + | _ -> "other" + """ + testCaseAsync "can get range of partial Active Pattern used in And pattern" + <| checkRanges + server + """ + let (|$DD$|_|) n = if n > 0 then Some n else None + let (|LessThan100|_|) n = if n < 100 then Some n else None + + let test n = + match n with + | $$ _ & LessThan100 _ -> "positive and less than 100" + | _ -> "other" + """ + testCaseAsync "can get range of partial Active Pattern with extracted value" + <| checkRanges + server + """ + let (|$DD$|_|) pattern input = + let m = System.Text.RegularExpressions.Regex.Match(input, pattern) + if m.Success then Some m.Value else None + + let parseEmail s = + match s with + | $$ @"[\w.-]+@[\w.-]+" email -> Some email + | _ -> None + """ + testCaseAsync "can get range of partial Active Pattern in script with local definition" + <| checkRangesScript + server + """ +let (|$DD$|_|) (s: string) = + let trimmed = s.Trim() + if trimmed <> s then Some trimmed else None + +let processInput input = + match input with + | $$ trimmed -> printfn "Trimmed: %s" trimmed + | other -> printfn "No trim needed: %s" other + +let test () = + match " hello " with + | $$ s -> s + | s -> s + """ + testCaseAsync "can get range of partial Active Pattern in script with multiple usages in same match" + <| checkRangesScript + server + """ +let (|$DD$|_|) (c: char) = if System.Char.IsUpper c then Some c else None +let (|Lower|_|) (c: char) = if System.Char.IsLower c then Some c else None + +let classifyChar c = + match c with + | $$ u -> sprintf "Upper: %c" u + | Lower l -> sprintf "Lower: %c" l + | _ -> "Other" + +let testMultiple chars = + chars |> List.map (fun c -> + match c with + | $$ _ -> "U" + | Lower _ -> "L" + | _ -> "O") + """ + testCaseAsync "can get range of partial Active Pattern defined in nested module" + <| checkRanges + server + """ + module Outer = + module Inner = + let (|$DD$|_|) (s: string) = + if s.StartsWith "A" then Some s else None + + open Outer.Inner + let test s = + match s with + | $$ v -> v + | _ -> "" + + let test2 s = + match s with + | Outer.Inner.$$ v -> v + | _ -> "" """ ]) +let private activePatternProjectTests state = + let path = + Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "FindReferences", "ActivePatternProject") + + serverTestList "ActivePatternProject" state defaultConfigDto (Some path) (fun server -> + [ testCaseAsync "can find references for Partial Active Pattern across .fs files in project" + <| async { + let! (activePatDoc, activePatDiags) = server |> Server.openDocument "ActivePatterns.fs" + Expect.isEmpty activePatDiags "There should be no diagnostics in ActivePatterns.fs" + + let! (_programDoc, programDiags) = server |> Server.openDocument "Program.fs" + Expect.isEmpty programDiags "There should be no diagnostics in Program.fs" + + // Find references from the definition in ActivePatterns.fs + let definitionPos = { Line = 2u; Character = 9u } // (|ParseInt|_|) + + let request: ReferenceParams = + { TextDocument = activePatDoc.TextDocumentIdentifier + Position = definitionPos + Context = { IncludeDeclaration = true } + WorkDoneToken = None + PartialResultToken = None } + + let! refs = activePatDoc.Server.Server.TextDocumentReferences request + + let allLocations = + refs + |> Flip.Expect.wantOk "Should not fail" + |> Flip.Expect.wantSome "Should return references" + + // Count references by file + let programRefs = + allLocations |> Array.filter (fun loc -> loc.Uri.Contains("Program.fs")) + + // Critical test: verify that cross-file partial active pattern references work + // We should find BOTH usages in Program.fs (test1 and test2/async) + Expect.hasLength programRefs 2 "Should find 2 usages in Program.fs (cross-file from ActivePatterns.fs)" + + // Verify the references are at the expected lines + let line4Ref = programRefs |> Array.exists (fun loc -> loc.Range.Start.Line = 4u) + let line11Ref = programRefs |> Array.exists (fun loc -> loc.Range.Start.Line = 11u) + + Expect.isTrue line4Ref "Should find reference at line 4 (test1 function)" + Expect.isTrue line11Ref "Should find reference at line 11 (test2 async block)" + } ]) + let tests state = testList "Find All References tests" [ scriptTests state solutionTests state untitledTests state - rangeTests state ] + rangeTests state + // activePatternTests state + + activePatternProjectTests state ] let tryFixupRangeTests (sourceTextFactory: ISourceTextFactory) = @@ -788,7 +1086,6 @@ let tryFixupRangeTests (sourceTextFactory: ISourceTextFactory) = Odd|>$ ) 42 let _ = MyModule.( - $<|Even| Odd|>$ @@ -846,7 +1143,6 @@ let tryFixupRangeTests (sourceTextFactory: ISourceTextFactory) = Odd|>$ ) 42 let _ = MyModule.( - $<|Even| Odd|>$ @@ -1166,3 +1462,5 @@ let tryFixupRangeTests (sourceTextFactory: ISourceTextFactory) = $<-.->$ ) 1 2 """ ] + + diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/ActivePatternProject.fsproj b/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/ActivePatternProject.fsproj new file mode 100644 index 000000000..dddd00b27 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/ActivePatternProject.fsproj @@ -0,0 +1,13 @@ + + + + net8.0 + Exe + + + + + + + + diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/ActivePatterns.fs b/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/ActivePatterns.fs new file mode 100644 index 000000000..2471ec58f --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/ActivePatterns.fs @@ -0,0 +1,6 @@ +module ActivePatterns + +let (|ParseInt|_|) (str: string) = +//> ^^^^^^^^^^^^^ Partial Active Pattern definition + let success, i = System.Int32.TryParse str + if success then Some i else None diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/Program.fs b/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/Program.fs new file mode 100644 index 000000000..68cf2a657 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/FindReferences/ActivePatternProject/Program.fs @@ -0,0 +1,20 @@ +open ActivePatterns + +let test1 = + match "42" with + | ParseInt i -> printfn $"Got int: {i}" +// ^^^^^^^^ Usage in test1 + | _ -> printfn "Not an int" + +let test2 x = + async { + match x with + | ParseInt i -> return i +// ^^^^^^^^ Usage in test2 async + | _ -> return 0 + } + +[] +let main argv = + test1 + 0