diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.200.md index 5a3649f260b..6058bac5fd8 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.200.md @@ -1,6 +1,7 @@ ### Added * F# Interactive gains a JSON-RPC server mode, `--fsi-server-jsonrpc:`, in which a host submits interactions over a named pipe and receives structured results — diagnostics with positions, escaping exceptions, the values each interaction bound, and the session's own process id — instead of recovering them by looking for a `SERVER-PROMPT>` marker in the output text. Program output continues to flow through the redirected console streams. The pipe admits only the user running the session; `--fsi-server-client-pid:` names the host process whose exit ends the session. `FsiEvaluationSession` exposes both options as `JsonRpcServerPipeName` and `JsonRpcClientProcessId`. The mode is part of the .NET fsi only. ([PR #20396](https://github.com/dotnet/fsharp/pull/20396)) +* Include individual active-pattern cases from unopened modules in pattern completion. ([PR #20719](https://github.com/dotnet/fsharp/pull/20719)) ### Fixed diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index fac10862948..7e5fe5478dc 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -1001,5 +1001,7 @@ val GetVisibleNamespacesAndModulesAtPoint: val IsItemResolvable: NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> Item -> bool +val ItemIsUnseen: AccessorDomain -> TcGlobals -> ImportMap -> range -> allowObsolete: bool -> Item -> bool + val TrySelectExtensionMethInfoOfILExtMem: range -> ImportMap -> TType -> TyconRef * MethInfo * ExtensionMethodPriority -> MethInfo option diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 4c5481e03e2..ef0e56b200d 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -1564,10 +1564,15 @@ type internal TypeCheckInfo loc, filterCtors, resolveOverloads, - isInRangeOperator, + completionContext: CompletionContext option, allSymbols: unit -> AssemblySymbol list, options: FSharpCodeCompletionOptions ) = + let isInRangeOperator = + match completionContext with + | Some CompletionContext.RangeOperator -> true + | _ -> false + let isSpread = FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1) |> Option.exists (fun i -> @@ -1761,6 +1766,19 @@ type internal TypeCheckInfo && match x.Symbol with + | :? FSharpActivePatternCase as symbol -> + match symbol.Item, completionContext with + | Item.ActivePatternCase case, Some(CompletionContext.Pattern _) -> + not ( + ItemIsUnseen + ad + g + ncenv.amap + m + options.SuggestObsoleteSymbols + (Item.Value case.ActivePatternVal) + ) + | _ -> false | :? FSharpMemberOrFunctionOrValue as m when m.IsConstructor && filterCtors = ResolveTypeNamesToTypeRefs -> @@ -1831,6 +1849,19 @@ type internal TypeCheckInfo | atStart when atStart = 0 -> 0 | otherwise -> otherwise - 1 + let pos = mkPos line colAtEndOfNamesAndResidue + + // Look for a "special" completion context + let completionContext = + // If the completion context we have computed higher up the stack is for the same position, + // reuse it, otherwise recompute + match completionContextAtPos with + | Some(contextForPos, context) when contextForPos = pos -> context + | _ -> + parseResultsOpt + |> Option.map (fun x -> x.ParseTree) + |> Option.bind (fun parseTree -> ParsedInput.TryGetCompletionContext(pos, parseTree, lineStr)) + let getDeclaredItemsNotInRangeOpWithAllSymbols () = GetDeclaredItems( parseResultsOpt, @@ -1843,24 +1874,11 @@ type internal TypeCheckInfo loc, filterCtors, resolveOverloads, - false, + completionContext, getAllSymbols, options ) - let pos = mkPos line colAtEndOfNamesAndResidue - - // Look for a "special" completion context - let completionContext = - // If the completion context we have computed higher up the stack is for the same position, - // reuse it, otherwise recompute - match completionContextAtPos with - | Some(contextForPos, context) when contextForPos = pos -> context - | _ -> - parseResultsOpt - |> Option.map (fun x -> x.ParseTree) - |> Option.bind (fun parseTree -> ParsedInput.TryGetCompletionContext(pos, parseTree, lineStr)) - let res = match completionContext with // Invalid completion locations @@ -1905,7 +1923,7 @@ type internal TypeCheckInfo loc, filterCtors, resolveOverloads, - false, + None, (fun () -> []), options ) @@ -1930,7 +1948,7 @@ type internal TypeCheckInfo loc, filterCtors, resolveOverloads, - false, + None, (fun () -> []), options ) @@ -1952,7 +1970,7 @@ type internal TypeCheckInfo loc, filterCtors, resolveOverloads, - false, + None, (fun () -> []), options ) @@ -2121,11 +2139,6 @@ type internal TypeCheckInfo // because providing generic parameters list is context aware, which we don't have here (yet). None | _ -> - let isInRangeOperator = - (match cc with - | Some CompletionContext.RangeOperator -> true - | _ -> false) - GetDeclaredItems( parseResultsOpt, lineStr, @@ -2137,7 +2150,7 @@ type internal TypeCheckInfo loc, filterCtors, resolveOverloads, - isInRangeOperator, + cc, getAllSymbols, options ) @@ -2229,7 +2242,9 @@ type internal TypeCheckInfo items let getAccessibility item = - FSharpSymbol.Create(cenv, item).Accessibility + match item with + | Item.ActivePatternCase case -> FSharpAccessibility(case.ActivePatternVal.Accessibility) + | _ -> FSharpSymbol.Create(cenv, item).Accessibility let currentNamespaceOrModule = parseResultsOpt diff --git a/src/Compiler/Service/ServiceAssemblyContent.fs b/src/Compiler/Service/ServiceAssemblyContent.fs index f08faa996a5..2fde460d218 100644 --- a/src/Compiler/Service/ServiceAssemblyContent.fs +++ b/src/Compiler/Service/ServiceAssemblyContent.fs @@ -12,6 +12,7 @@ open System.Collections.Generic open Internal.Utilities.Library open FSharp.Compiler.Diagnostics open FSharp.Compiler.IO +open FSharp.Compiler.NameResolution open FSharp.Compiler.Symbols open FSharp.Compiler.Syntax @@ -168,23 +169,33 @@ module AssemblyContent = UnresolvedSymbol = UnresolvedSymbol topRequireQualifiedAccessParent cleanIdents fullName ns }) - let traverseMemberFunctionAndValues ns (parent: Parent) (membersFunctionsAndValues: seq) = + let createFunctionOrValue ns (parent: Parent) = let topRequireQualifiedAccessParent = parent.TopRequiresQualifiedAccess false |> Option.map parent.FixParentModuleSuffix + let nearestRequireQualifiedAccessParent = parent.ThisRequiresQualifiedAccess true |> Option.map parent.FixParentModuleSuffix let autoOpenParent = parent.AutoOpen |> Option.map parent.FixParentModuleSuffix + fun fullName idents (symbol: FSharpSymbol) isActivePattern -> + let cleanedIdents = parent.FixParentModuleSuffix idents + { FullName = fullName + CleanedIdents = cleanedIdents + Namespace = ns + NearestRequireQualifiedAccessParent = nearestRequireQualifiedAccessParent + TopRequireQualifiedAccessParent = topRequireQualifiedAccessParent + AutoOpenParent = autoOpenParent + Symbol = symbol + Kind = fun _ -> EntityKind.FunctionOrValue isActivePattern + UnresolvedSymbol = UnresolvedSymbol topRequireQualifiedAccessParent cleanedIdents fullName ns } + + let isPublic (symbol: FSharpSymbol) = + match symbol.Item with + | Item.ActivePatternCase case -> case.ActivePatternVal.Accessibility.IsPublic + | _ -> symbol.Accessibility.IsPublic + + let traverseMemberFunctionAndValues (createSymbol: string -> ShortIdents -> FSharpSymbol -> bool -> AssemblySymbol) (membersFunctionsAndValues: seq) = membersFunctionsAndValues |> Seq.filter (fun x -> not x.IsInstanceMember && not x.IsPropertyGetterMethod && not x.IsPropertySetterMethod) |> Seq.collect (fun func -> let processIdents fullName idents = - let cleanedIdents = parent.FixParentModuleSuffix idents - { FullName = fullName - CleanedIdents = cleanedIdents - Namespace = ns - NearestRequireQualifiedAccessParent = parent.ThisRequiresQualifiedAccess true |> Option.map parent.FixParentModuleSuffix - TopRequireQualifiedAccessParent = topRequireQualifiedAccessParent - AutoOpenParent = autoOpenParent - Symbol = func - Kind = fun _ -> EntityKind.FunctionOrValue func.IsActivePattern - UnresolvedSymbol = UnresolvedSymbol topRequireQualifiedAccessParent cleanedIdents fullName ns } + createSymbol fullName idents func func.IsActivePattern [ yield! func.TryGetFullDisplayName() |> Option.map (fun fullDisplayName -> @@ -252,9 +263,23 @@ module AssemblyContent = Namespace = ns IsModule = entity.IsFSharpModule } + let createValue = createFunctionOrValue ns currentParent match entity.TryGetMembersFunctionsAndValues() with | xs when xs.Count > 0 -> - yield! traverseMemberFunctionAndValues ns currentParent xs + yield! traverseMemberFunctionAndValues createValue xs + | _ -> () + + match currentEntity with + | Some moduleSymbol when entity.IsFSharpModule -> + for case in entity.ActivePatternCases do + if contentType = Full || isPublic case then + let idents = Array.append moduleSymbol.CleanedIdents [| case.Name |] + let symbol = createValue case.FullName idents case true + let struct (_, openableNs, restIdents) = + Entity.getOpenableNamespace symbol.TopRequireQualifiedAccessParent symbol.AutoOpenParent symbol.CleanedIdents + yield { symbol with + UnresolvedSymbol = + UnresolvedSymbol None (Array.append openableNs restIdents) case.FullName (Some openableNs) } | _ -> () for e in (try entity.NestedEntities :> _ seq with _ -> Seq.empty) do @@ -312,7 +337,7 @@ module AssemblyContent = |> List.filter (fun entity -> match contentType with | Full -> true - | Public -> entity.Symbol.Accessibility.IsPublic) + | Public -> isPublic entity.Symbol) type EntityCache() = let dic = Dictionary() @@ -325,4 +350,3 @@ type EntityCache() = member _.Clear() = dic.Clear() member x.Locking f = lock dic <| fun _ -> f (x :> IAssemblyContentCache) - diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 8d31b36f9c0..1deea463f86 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -1238,8 +1238,9 @@ type DeclarationListInfo(declarations: DeclarationListItem[], isForType: bool, i item.Unresolved |> Option.map (fun x -> x.Namespace) |> Option.bind (fun ns -> - if ns |> Array.startsWith fsharpNamespace then None - else Some ns) + match item.Item with + | Item.ActivePatternCase _ -> Some ns + | _ -> if ns |> Array.startsWith fsharpNamespace then None else Some ns) |> Option.map (fun ns -> match currentNamespace with | Some currentNs -> diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 7ee76f4652e..bff04ef1658 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -204,6 +204,24 @@ module Entity = candidateNs[0 .. nsCount - 1] + let getOpenableNamespace (requiresQualifiedAccessParent: ShortIdents option) autoOpenParent (candidate: ShortIdents) = + let openableNsCount = + match requiresQualifiedAccessParent with + | Some parent -> min parent.Length candidate.Length + | None -> candidate.Length + + let fullOpenableNs = candidate[0 .. openableNsCount - 2] + struct (fullOpenableNs, cutAutoOpenModules autoOpenParent fullOpenableNs, candidate[openableNsCount - 1 ..]) + + let formatIdents idents = + idents + |> Array.map (fun ident -> + if IsOperatorDisplayName ident then + ident + else + NormalizeIdentifierBackticks ident) + |> String.concat "." + let tryCreate ( targetNamespace: ShortIdents option, @@ -230,15 +248,8 @@ module Entity = else let identCount = parts.Length - let fullOpenableNs, restIdents = - let openableNsCount = - match requiresQualifiedAccessParent with - | Some parent -> min parent.Length candidate.Length - | None -> candidate.Length - - candidate[0 .. openableNsCount - 2], candidate[openableNsCount - 1 ..] - - let openableNs = cutAutoOpenModules autoOpenParent fullOpenableNs + let struct (fullOpenableNs, openableNs, restIdents) = + getOpenableNamespace requiresQualifiedAccessParent autoOpenParent candidate let getRelativeNs ns = match targetNamespace, candidateNamespace with @@ -258,8 +269,8 @@ module Entity = match relativeNs with | [||] -> None | _ when identCount > 1 && relativeNs.Length >= identCount -> - Some(relativeNs[0 .. relativeNs.Length - identCount] |> String.concat ".") - | _ -> Some(relativeNs |> String.concat ".") + Some(relativeNs[0 .. relativeNs.Length - identCount] |> formatIdents) + | _ -> Some(formatIdents relativeNs) let qualifier = if fullRelativeName.Length > 1 && fullRelativeName.Length >= identCount then @@ -269,13 +280,13 @@ module Entity = Some { - FullRelativeName = String.concat "." fullRelativeName //.[0..fullRelativeName.Length - identCount - 1] - Qualifier = String.concat "." qualifier + FullRelativeName = formatIdents fullRelativeName + Qualifier = formatIdents qualifier Namespace = ns FullDisplayName = match restIdents with | [| _ |] -> "" - | _ -> String.concat "." restIdents + | _ -> formatIdents restIdents LastIdent = Array.tryLast restIdents |> Option.defaultValue "" }) diff --git a/src/Compiler/Service/ServiceParsedInputOps.fsi b/src/Compiler/Service/ServiceParsedInputOps.fsi index 1b28bfb18d3..a816b423b80 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fsi +++ b/src/Compiler/Service/ServiceParsedInputOps.fsi @@ -210,6 +210,15 @@ module public ParsedInput = /// Corrects insertion line number based on kind of scope and text surrounding the insertion point. val AdjustInsertionPoint: getLineStr: (int -> string) -> ctx: InsertionContext -> pos +[] +module internal Entity = + + val getOpenableNamespace: + requiresQualifiedAccessParent: ShortIdents option -> + autoOpenParent: ShortIdents option -> + candidate: ShortIdents -> + struct (ShortIdents * ShortIdents * ShortIdents) + // implementation details used by other code in the compiler module internal SourceFileImpl = diff --git a/tests/FSharp.Compiler.Service.Tests/ActivePatternCompletionTests.fs b/tests/FSharp.Compiler.Service.Tests/ActivePatternCompletionTests.fs new file mode 100644 index 00000000000..2383b9b2b56 --- /dev/null +++ b/tests/FSharp.Compiler.Service.Tests/ActivePatternCompletionTests.fs @@ -0,0 +1,325 @@ +module FSharp.Compiler.Service.Tests.ActivePatternCompletionTests + +open System +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.EditorServices +open FSharp.Compiler.Service.Tests.Common +open FSharp.Compiler.Symbols +open FSharp.Compiler.Syntax.PrettyNaming +open FSharp.Compiler.Text +open Xunit + +let private patterns = """ +namespace Candidates +open System + +module Normal = + let ordinaryValue = 1 + let (++) left right = 10 * left + right + type Thing = class end + let (|Even|Odd|) value = if value % 2 = 0 then Even else Odd + let (|Total|) value = value + let (|Positive|_|) value = if value > 0 then Some value else None + let (|Above|_|) threshold value = if value > threshold then Some value else None + let private (|Private|_|) value = Some value + let internal (|Internal|_|) value = Some value + [] + let (|Old|_|) value = Some value + [] + let (|Hidden|_|) value = Some value + +module private PrivateModule = + let (|Secret|_|) value = Some value + +module Other = + let (|Positive|_|) value = Some value + +[] +module Auto = + let (|AutoCase|_|) value = Some value + [] + module Nested = + let (|Deep|_|) value = Some value + module Ordinary = + let (|OrdinaryCase|_|) value = Some value + +[] +module Qualified = + let (|Restricted|_|) value = Some value + +[] +module Suffix = + let (|SuffixCase|_|) value = Some value + +module ``Space module`` = + let (|``Has space``|_|) value = Some value + +namespace Microsoft.FSharp.Core +module Unopened = + let coreValue = 1 + let (|CoreCase|_|) value = Some value +""" + +let private check markedSource = + let context = Checker.getCompletionContext markedSource + let options = createProjectOptionsFromNamedSources [ "Patterns.fs", patterns; "Consumer.fs", context.Source ] [] + let _, producer = parseAndCheckFile options.SourceFiles[0] patterns options + Assert.Empty producer.Diagnostics + let parse, results = parseAndCheckFile options.SourceFiles[1] context.Source options + let catalogue = AssemblyContent.GetAssemblySignatureContent AssemblyContentType.Full results.PartialAssemblySignature + let complete completionOptions getAllEntities = + results.GetDeclarationListInfo( + Some parse, context.Pos.Line, context.LineText, context.PartialIdentifier, + getAllEntities = getAllEntities, options = completionOptions) + let item predicate = + (complete FSharpCodeCompletionOptions.Default (fun () -> catalogue)).Items + |> Array.filter predicate + |> Assert.Single + let insert (symbol: AssemblySymbol) partiallyQualified = + ParsedInput.TryFindInsertionContext context.Pos.Line parse.ParseTree partiallyQualified OpenStatementInsertionPoint.TopLevel + (symbol.TopRequireQualifiedAccessParent, symbol.AutoOpenParent, symbol.Namespace, symbol.CleanedIdents) + |> Assert.Single + let checkEdit edited = + let _, checkedResults = parseAndCheckFile options.SourceFiles[1] edited options + assertNoDiagnostics checkedResults + checkedResults + struct {| Context = context; Parse = parse; Results = results; Catalogue = catalogue; Complete = complete; Item = item; Insert = insert; CheckEdit = checkEdit |} + +[] +[] +[] +[] +[] +[] +[] +[] +[] +[] +let ``unopened cases provide compiling completion and import edits`` (caseName: string, owner: string, arguments: string, nameInCode: string, namespaceToOpen: string, qualifiedName: string) = + let sourceName = NormalizeIdentifierBackticks caseName + let marked = $"module Consumer\nlet classify value = match value with | {sourceName}{{caret}}{arguments} -> 1 | _ -> 0" + let test = check marked + if arguments <> "" then + Assert.Contains(test.Results.Diagnostics, fun diagnostic -> diagnostic.ErrorNumber = 39) + let symbol = + test.Catalogue + |> List.find (fun symbol -> String.concat "." symbol.CleanedIdents = $"Candidates.{owner}.{caseName}") + let entity, insertionContext = + test.Insert symbol [| { Ident = caseName; Resolved = false } |] + Assert.Equal(Some namespaceToOpen, entity.Namespace) + Assert.Equal(qualifiedName, entity.FullRelativeName) + Assert.Equal(qualifiedName, entity.Qualifier) + let importedName = if entity.FullDisplayName = "" then sourceName else entity.FullDisplayName + Assert.Equal(nameInCode, importedName) + + let item = test.Item (fun item -> item.FullName = symbol.FullName) + Assert.Equal(nameInCode, item.NameInCode) + Assert.Equal(Some namespaceToOpen, item.NamespaceToOpen) + + let checkEdit insertedName openNamespace = + let source = test.Context.Source.Replace(sourceName, insertedName) + let lines = SourceContext.getLines source + let edited = + match openNamespace with + | Some ns -> + let pos = ParsedInput.AdjustInsertionPoint (fun line -> lines[line].Trim()) insertionContext + Assert.Equal(Position.mkPos 2 0, pos) + lines |> Array.insertAt (pos.Line - 1) $"open {ns}" |> String.concat "\n" + | None -> source + let results = test.CheckEdit edited + if openNamespace.IsSome then + let unused = UnusedOpens.getUnusedOpens(results, fun line -> (SourceContext.getLines edited)[line - 1]) |> Async.RunSynchronouslyImmediate + Assert.Empty unused + checkEdit item.NameInCode item.NamespaceToOpen + checkEdit entity.Qualifier None + +[] +[ n")>] +[] +[ n")>] +let ``unopened cases complete match binding and lambda patterns`` (body: string) = + let test = check $"module Consumer\n{body}" + let symbol = test.Catalogue |> List.find (fun symbol -> symbol.CleanedIdents = [| "Candidates"; "Normal"; "Total" |]) + let item = test.Item (fun item -> item.FullName = symbol.FullName) + Assert.Equal("Total", item.NameInCode) + Assert.Equal(Some "Candidates.Normal", item.NamespaceToOpen) + let edited = $"""module Consumer +open {item.NamespaceToOpen.Value} +{body.Replace("{caret}", "")}""" + test.CheckEdit edited |> ignore + +[] +[] +[] +let ``case completion uses backing value visibility and obsolete settings`` suggestObsolete = + let test = check "module Consumer\nlet classify value = match value with | P{caret} n -> 1 | _ -> 0" + let options = { FSharpCodeCompletionOptions.Default with SuggestObsoleteSymbols = suggestObsolete } + let items = (test.Complete options (fun () -> test.Catalogue)).Items + let contains name = items |> Array.exists (fun item -> item.FullName.EndsWith($".{name}", StringComparison.Ordinal)) + Assert.False(contains "Private") + Assert.False(contains "Secret") + if not suggestObsolete then Assert.False(contains "Hidden") + Assert.Equal(suggestObsolete, contains "Old") + Assert.True(contains "Internal") + let internalCase = items |> Array.find (fun item -> item.FullName.EndsWith(".Internal", StringComparison.Ordinal)) + Assert.True internalCase.Accessibility.IsInternal + +[] +let ``case catalogue does not leak into expressions`` () = + let test = check "module Consumer\nlet value = P{caret}" + let info = test.Complete FSharpCodeCompletionOptions.Default (fun () -> test.Catalogue) + let identities = + test.Catalogue + |> List.filter (fun symbol -> symbol.Symbol :? FSharpActivePatternCase) + |> List.map _.FullName + |> Set.ofList + Assert.DoesNotContain(info.Items, fun item -> identities.Contains item.FullName) + Assert.Contains(info.Items, fun item -> item.NameInCode = "Normal" && item.NamespaceToOpen = Some "Candidates") + let symbols = + test.Results.GetDeclarationListSymbols( + Some test.Parse, test.Context.Pos.Line, test.Context.LineText, test.Context.PartialIdentifier, + getAllEntities = (fun () -> test.Catalogue)) + |> List.collect id + Assert.DoesNotContain(symbols, fun symbol -> identities.Contains symbol.Symbol.FullName) + +[] +[ n | _ -> 0", true)>] +[ n | _ -> 0", true)>] +[ n | _ -> 0", true)>] +[ n | _ -> 0", true)>] +[] +let ``editor scoped case query reuses FCS context and backing value policies`` (body: string, isPattern: bool) = + let test = check $"module Consumer\n{body}" + let cases = test.Catalogue |> List.filter (fun symbol -> symbol.Symbol :? FSharpActivePatternCase) + let partialName = { test.Context.PartialIdentifier with QualifyingIdents = []; PartialIdent = ""; LastDotPos = None } + let identities = + test.Results.GetDeclarationListSymbols( + Some test.Parse, test.Context.Pos.Line, test.Context.LineText, partialName, getAllEntities = (fun () -> cases)) + |> List.collect id + |> List.map (fun symbol -> symbol.Symbol.FullName) + |> Set.ofList + for case in cases do + let name = Array.last case.CleanedIdents + if name = "Private" || name = "Secret" || name = "Hidden" || name = "Old" then + Assert.False(identities.Contains case.FullName) + elif name = "Positive" then + Assert.Equal(isPattern, identities.Contains case.FullName) + +[] +[] +[] +let ``editor RQA action keeps the qualification needed by the applied pattern`` (pattern: string, canOpen: bool) = + let test = check $"module Consumer\nlet classify value = match value with | {pattern}{{caret}} n -> n | _ -> 0" + let symbol = test.Catalogue |> List.find (fun symbol -> symbol.CleanedIdents = [| "Candidates"; "Qualified"; "Restricted" |]) + let unresolved = + pattern.Split '.' + |> Array.mapi (fun index ident -> { Ident = ident; Resolved = index <> 0 }) + let entity, _ = test.Insert symbol unresolved + Assert.Equal(canOpen, entity.FullDisplayName = "" || entity.FullDisplayName = pattern) + let edited = + if canOpen then + Assert.Equal(Some "Candidates", entity.Namespace) + test.Context.Source.Replace("module Consumer", "module Consumer\nopen Candidates") + else + Assert.Equal("Candidates.Qualified.Restricted", entity.Qualifier) + test.Context.Source.Replace("| Restricted n", $"| {entity.Qualifier} n") + test.CheckEdit edited |> ignore + +[] +let ``case completion preserves per call catalogues and distinct candidates`` () = + let test = check "module Consumer\nlet classify value = match value with | Positive{caret} n -> 1 | _ -> 0" + let complete catalogue = (test.Complete FSharpCodeCompletionOptions.Default (fun () -> catalogue)).Items + let cases = test.Catalogue |> List.filter (fun symbol -> symbol.Symbol :? FSharpActivePatternCase) + let candidates = complete cases |> Array.filter (fun item -> item.NameInCode = "Positive") + Assert.Equal([| Some "Candidates.Normal"; Some "Candidates.Other" |], candidates |> Array.map _.NamespaceToOpen |> Array.sort) + Assert.DoesNotContain(complete [], fun item -> candidates |> Array.exists (fun candidate -> candidate.FullName = item.FullName)) + for candidate in candidates do + let catalogue = cases |> List.filter (fun symbol -> symbol.FullName = candidate.FullName) + let actual = complete catalogue |> Array.filter (fun item -> item.NameInCode = "Positive") |> Assert.Single + Assert.Equal(candidate.NamespaceToOpen, actual.NamespaceToOpen) + +[] +[] +[] +[] +let ``already visible cases are not duplicated by the catalogue`` (openNamespace: string, caseName: string) = + let test = check $"module Consumer\nopen {openNamespace}\nlet classify value = match value with | {caseName}{{caret}} n -> 1 | _ -> 0" + let candidates = + (test.Complete FSharpCodeCompletionOptions.Default (fun () -> test.Catalogue)).Items + |> Array.filter (fun item -> item.NameInCode = caseName) + let expected = if caseName = "Positive" then [| None; Some "Candidates.Other" |] else [| None |] + Assert.Equal(expected, candidates |> Array.map _.NamespaceToOpen |> Array.sort) + +[] +let ``private cases remain available inside their defining module`` () = + let test = check """ +module Consumer +module Local = + let private (|LocalPrivate|_|) value = Some value + let classify value = match value with | LocalPrivate{caret} n -> n | _ -> 0 +""" + let symbol = test.Catalogue |> List.find (fun symbol -> symbol.CleanedIdents = [| "Consumer"; "Local"; "LocalPrivate" |]) + let item = test.Item (fun item -> item.FullName = symbol.FullName) + Assert.Equal("LocalPrivate", item.NameInCode) + Assert.Equal(None, item.NamespaceToOpen) + +[] +let ``partially qualified case uses existing import and qualification paths`` () = + let test = check "module Consumer\nlet classify value = match value with | Normal.Positive{caret} n -> 1 | _ -> 0" + let symbol = test.Catalogue |> List.find (fun symbol -> symbol.CleanedIdents = [| "Candidates"; "Normal"; "Positive" |]) + let entity, _ = + test.Insert symbol [| { Ident = "Normal"; Resolved = false }; { Ident = "Positive"; Resolved = true } |] + Assert.Equal(Some "Candidates", entity.Namespace) + Assert.Equal("Candidates.Normal", entity.Qualifier) + let edited = test.Context.Source.Replace("Normal.Positive", $"{entity.Qualifier}.Positive") + test.CheckEdit edited |> ignore + let opened = test.Context.Source.Replace("module Consumer", "module Consumer\nopen Candidates") + test.CheckEdit opened |> ignore + let visible = check (opened.Replace("Normal.Positive", "Normal.Positive{caret}")) + let item = visible.Item (fun item -> item.NameInCode = "Positive") + Assert.Equal(None, item.NamespaceToOpen) + +[] +let ``unknown bare uppercase binding remains valid`` () = + let test = check "module Consumer\nlet Even{caret} = 1" + Assert.Empty test.Results.Diagnostics + test.Complete FSharpCodeCompletionOptions.Default (fun () -> test.Catalogue) |> ignore + Assert.Empty test.Results.Diagnostics + +[] +let ``FSharp namespace does not make an unopened case module visible`` () = + let test = check "module Consumer\nlet classify value = match value with | CoreCase{caret} n -> n | _ -> 0" + let item = test.Item (fun item -> item.NameInCode = "CoreCase") + Assert.Equal(Some "Microsoft.FSharp.Core.Unopened", item.NamespaceToOpen) + let edited = test.Context.Source.Replace("module Consumer", $"module Consumer\nopen {item.NamespaceToOpen.Value}") + test.CheckEdit edited |> ignore + +[] +let ``FSharp namespace keeps ordinary value completion without an extra open`` () = + let test = check "module Consumer\nopen Microsoft.FSharp.Core\nlet value = coreValue{caret}" + let symbol = test.Catalogue |> List.find (fun symbol -> symbol.CleanedIdents = [| "Microsoft"; "FSharp"; "Core"; "Unopened"; "coreValue" |]) + let item = test.Item (fun item -> item.FullName = symbol.FullName) + Assert.Equal("Unopened.coreValue", item.NameInCode) + Assert.Equal(None, item.NamespaceToOpen) + let edited = test.Context.Source.Replace("coreValue", item.NameInCode) + test.CheckEdit edited |> ignore + +[] +[] +[] +[] +let ``existing value type and operator import paths still compile`` (name: string, body: string) = + let test = check $"module Consumer\n{body}" + let symbol = test.Catalogue |> List.find (fun symbol -> symbol.CleanedIdents = [| "Candidates"; "Normal"; name |]) + let entity, _ = + test.Insert symbol [| { Ident = name; Resolved = false } |] + Assert.Equal(Some "Candidates.Normal", entity.Namespace) + Assert.Equal($"Candidates.Normal.{name}", entity.Qualifier) + for edited in + [ test.Context.Source.Replace(name, entity.Qualifier) + test.Context.Source.Replace("module Consumer", "module Consumer\nopen Candidates.Normal") ] do + test.CheckEdit edited |> ignore + if name <> "(++)" then + let item = test.Item (fun item -> item.FullName = symbol.FullName) + Assert.Equal($"Normal.{name}", item.NameInCode) + Assert.Equal(Some "Candidates", item.NamespaceToOpen) diff --git a/tests/FSharp.Compiler.Service.Tests/AssemblyContentProviderTests.fs b/tests/FSharp.Compiler.Service.Tests/AssemblyContentProviderTests.fs index 5df4bf71912..2b2afc68166 100644 --- a/tests/FSharp.Compiler.Service.Tests/AssemblyContentProviderTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/AssemblyContentProviderTests.fs @@ -1,19 +1,22 @@ module FSharp.Compiler.Service.Tests.AssemblyContentProviderTests open System +open System.IO open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.EditorServices open FSharp.Compiler.Service.Tests.Common +open FSharp.Compiler.Symbols open FSharp.Test +open Xunit -let private filePath = "C:\\test.fs" +let private filePath = Path.Combine(Path.GetTempPath(), "test.fs") let private projectOptions : FSharpProjectOptions = - { ProjectFileName = "C:\\test.fsproj" + { ProjectFileName = Path.ChangeExtension(filePath, ".fsproj") ProjectId = None SourceFiles = [| filePath |] ReferencedProjects = [| |] - OtherOptions = [| |] + OtherOptions = mkProjectCommandLineArgsSilent ("test.dll", []) IsIncompleteTypeCheckEnvironment = true UseScriptResolutionRules = false LoadTime = DateTime.MaxValue @@ -62,7 +65,7 @@ let private getSymbolMap (getSymbolProperty: AssemblySymbol -> 'a) (source: stri |> List.map (fun s -> getCleanedFullName s, getSymbolProperty s) |> Map.ofList -[] +[] let ``implicitly added Module suffix is removed``() = """ type MyType = { F: int } @@ -75,7 +78,7 @@ module MyType = "Test.MyType" "Test.MyType.func123"] -[] +[] let ``Module suffix added by an explicitly applied ModuleSuffix attribute is removed``() = """ [] @@ -86,7 +89,7 @@ module MyType = "Test.MyType" "Test.MyType.func123" ] -[] +[] let ``Property getters and setters are removed``() = """ type MyType() = @@ -96,7 +99,7 @@ let ``Property getters and setters are removed``() = "Test.MyType" "Test.MyType.MyProperty" ] -[] +[] let ``TopRequireQualifiedAccessParent property should be valid``() = let source = """ module M1 = @@ -143,7 +146,7 @@ let ``TopRequireQualifiedAccessParent property should be valid``() = assertAreEqual (expectedResult, actual) -[] +[] let ``Check Unresolved Symbols``() = let source = """ namespace ``1 2 3`` @@ -206,6 +209,7 @@ module Test = "1 2 3.Test.M1.E", "open ``1 2 3`` - Test.M1.E"; "1 2 3.Test.M1.F", "open ``1 2 3`` - Test.M1.F"; "1 2 3.Test.M1.G", "open ``1 2 3`` - Test.M1.G"; + "1 2 3.Test.M1.Is1", "open ``1 2 3``.Test.M1 - Is1"; "1 2 3.Test.M1.M11", "open ``1 2 3`` - Test.M1.M11"; "1 2 3.Test.M1.M11.M111", "open ``1 2 3`` - Test.M1.M11.M111"; "1 2 3.Test.M1.M11.M111.v111", "open ``1 2 3`` - Test.M1.M11.M111.v111"; @@ -227,3 +231,129 @@ module Test = $"open {ns} - {i.UnresolvedSymbol.DisplayName}") assertAreEqual (expectedResult, actual) + +let private activePatternSource = """ +namespace Catalogue + +[] +[] +module Patterns = + let (|Even|Odd|) value = if value % 2 = 0 then Even else Odd + let (|Positive|_|) value = if value > 0 then Some value else None + let (|Above|_|) threshold value = if value > threshold then Some value else None + let (|Case|CASE|) value = if value then Case else CASE + let (|``Has space``|_|) value = if value > 0 then Some value else None + let private (|Private|_|) value = if value > 0 then Some value else None + let internal (|Internal|_|) value = if value > 0 then Some value else None + + [] + module Nested = + let (|Even|_|) value = if value % 2 = 0 then Some value else None + + module private Hidden = + let (|HiddenCase|_|) value = if value > 0 then Some value else None +""" + +let private checkSources sources = + let options = createProjectOptionsFromNamedSources sources [] + let filePath = Array.last options.SourceFiles + let _, results = parseAndCheckFile filePath (snd (List.last sources)) options + Assert.Empty results.Diagnostics + options, results + +let private activePatternCases symbols = + symbols + |> List.filter (fun symbol -> symbol.Symbol :? FSharpActivePatternCase) + +[] +[] +[] +[] +[] +[] +[] +[] +let ``active pattern catalogue preserves case identity and source names`` (caseName, index) = + let _, results = checkSources [ "Patterns.fs", activePatternSource ] + let symbols = AssemblyContent.GetAssemblySignatureContent AssemblyContentType.Full results.PartialAssemblySignature + let symbol = + activePatternCases symbols + |> List.find (fun symbol -> symbol.CleanedIdents = [| "Catalogue"; "Patterns"; caseName |]) + let case = Assert.IsType symbol.Symbol + Assert.Equal(caseName, case.Name) + Assert.Equal(index, case.Index) + Assert.Equal(case.FullName, symbol.FullName) + Assert.NotEqual(getCleanedFullName symbol, symbol.FullName) + Assert.Equal(Some [| "Catalogue" |], symbol.Namespace) + Assert.Equal(Some [| "Catalogue"; "Patterns" |], symbol.NearestRequireQualifiedAccessParent) + Assert.Equal(Some [| "Catalogue"; "Patterns" |], symbol.TopRequireQualifiedAccessParent) + Assert.Equal(None, symbol.AutoOpenParent) + Assert.Equal(symbol.FullName, symbol.UnresolvedSymbol.FullName) + Assert.Equal([| "Catalogue" |], symbol.UnresolvedSymbol.Namespace) + let sourceName = FSharp.Compiler.Syntax.PrettyNaming.NormalizeIdentifierBackticks caseName + Assert.Equal($"Patterns.{sourceName}", symbol.UnresolvedSymbol.DisplayName) + Assert.Equal(EntityKind.FunctionOrValue true, symbol.Kind LookupType.Precise) + Assert.Contains(symbols, fun symbol -> + match symbol.Symbol with + | :? FSharpMemberOrFunctionOrValue as value -> value.IsActivePattern && case.Group.Name = Some value.LogicalName + | _ -> false) + +[] +[] +[] +let ``active pattern catalogue respects defining value and container visibility`` publicOnly = + let project, results = checkSources [ "Patterns.fs", activePatternSource ] + let contentType = if publicOnly then AssemblyContentType.Public else AssemblyContentType.Full + let expected = + [ "Catalogue.Patterns.Above"; "Catalogue.Patterns.CASE"; "Catalogue.Patterns.Case" + "Catalogue.Patterns.Even"; "Catalogue.Patterns.Has space"; "Catalogue.Patterns.Nested.Even" + "Catalogue.Patterns.Odd"; "Catalogue.Patterns.Positive" + if not publicOnly then + "Catalogue.Patterns.Hidden.HiddenCase" + "Catalogue.Patterns.Internal" + "Catalogue.Patterns.Private" ] + |> List.sort + let output = Path.ChangeExtension(project.ProjectFileName, ".dll") + let source = """ +module Consumer +let classified = match 2 with | Catalogue.Patterns.Even -> true | Catalogue.Patterns.Odd -> false +""" + let options = createProjectOptionsFromNamedSources [ "Consumer.fs", source ] [ $"-r:{output}" ] + let options = { options with ReferencedProjects = [| FSharpReferencedProject.FSharpReference(output, project) |] } + let _, consumer = parseAndCheckFile options.SourceFiles[0] source options + Assert.Empty consumer.Diagnostics + let assemblies = + consumer.ProjectContext.GetReferencedAssemblies() + |> List.filter (fun assembly -> assembly.SimpleName = Path.GetFileNameWithoutExtension output) + Assert.Single assemblies |> ignore + let catalogue = AssemblyContent.GetAssemblySignatureContent contentType results.PartialAssemblySignature + let actual = activePatternCases catalogue |> List.map getCleanedFullName |> List.sort + Assert.Equal(expected, actual) + let nested = catalogue |> List.find (fun symbol -> getCleanedFullName symbol = "Catalogue.Patterns.Nested.Even") + Assert.Equal(Some [| "Catalogue"; "Patterns"; "Nested" |], nested.AutoOpenParent) + let cache = EntityCache() + let cacheKey = Some project.SourceFiles[0] + AssemblyContent.GetAssemblyContent cache.Locking AssemblyContentType.Full cacheKey assemblies |> ignore + let cached = + AssemblyContent.GetAssemblyContent cache.Locking contentType cacheKey assemblies + |> activePatternCases + |> List.map getCleanedFullName + |> List.sort + Assert.Equal(expected, cached) + +[] +let ``active pattern catalogue respects signature visibility`` () = + let signature = """ +namespace Catalogue +[] +[] +module Patterns = + val (|Even|Odd|): int -> Choice +""" + let _, results = checkSources [ "Patterns.fsi", signature; "Patterns.fs", activePatternSource ] + let actual = + AssemblyContent.GetAssemblySignatureContent AssemblyContentType.Full results.PartialAssemblySignature + |> activePatternCases + |> List.map getCleanedFullName + |> List.sort + Assert.Equal([ "Catalogue.Patterns.Even"; "Catalogue.Patterns.Odd" ], actual) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 2ff9555dee6..b92e18f663c 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -135,6 +135,7 @@ +