Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 4 additions & 4 deletions src/Compiler/Checking/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -363,7 +363,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath (env:
match enclosingNamespacePathToOpen with
| id :: rest ->
let ad = env.AccessRights
match ResolveLongIdentAsModuleOrNamespace tcSink amap scopem true OpenQualified env.eNameResEnv ad id rest true with
match ResolveLongIdentAsModuleOrNamespace tcSink amap scopem true OpenQualified env.eNameResEnv ad id rest true ShouldNotifySink.Yes with
| Result modrefs ->
let modrefs = List.map p23 modrefs
let lid = SynLongIdent(enclosingNamespacePathToOpen, [] , [])
Expand Down Expand Up @@ -639,7 +639,7 @@ let TcOpenLidAndPermitAutoResolve tcSink (env: TcEnv) amap (longId : Ident list)
| [] -> []
| id :: rest ->
let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges
match ResolveLongIdentAsModuleOrNamespace tcSink amap m true OpenQualified env.NameEnv ad id rest true with
match ResolveLongIdentAsModuleOrNamespace tcSink amap m true OpenQualified env.NameEnv ad id rest true ShouldNotifySink.Yes with
| Result res -> res
| Exception err ->
errorR(err); []
Expand Down Expand Up @@ -1531,7 +1531,7 @@ module MutRecBindingChecking =
let resolved =
match p with
| [] -> Result []
| id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.NameEnv ad id rest false
| id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.NameEnv ad id rest false ShouldNotifySink.Yes

let mvvs = ForceRaise resolved

Expand Down Expand Up @@ -4738,7 +4738,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE
let resolved =
match p with
| [] -> Result []
| id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.NameEnv ad id rest false
| id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.NameEnv ad id rest false ShouldNotifySink.Yes
let mvvs = ForceRaise resolved
let scopem = unionRanges m endm
let unfilteredModrefs = mvvs |> List.map p23
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -7334,7 +7334,7 @@ and TcConstExpr cenv (overallTy: OverallTy) env m tpenv c =
let expr =
let modName = "NumericLiteral" + suffix
let ad = env.eAccessRights
match ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with
match ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false ShouldNotifySink.Yes with
| Result []
| Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule modName, m))
| Result ((_, mref, _) :: _) ->
Expand Down Expand Up @@ -8121,7 +8121,7 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) =
let resolvedToModuleOrNamespaceName =
if delayed.IsEmpty then
let id,rest = List.headAndTail longId
match ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.eNameResEnv ad id rest true with
match ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.eNameResEnv ad id rest true ShouldNotifySink.Yes with
| Result modref when delayed.IsEmpty && modref |> List.exists (p23 >> IsEntityAccessible cenv.amap m ad) ->
true // resolved to a module or namespace, done with checks
| _ ->
Expand Down
30 changes: 18 additions & 12 deletions src/Compiler/Checking/NameResolution.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2364,14 +2364,19 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities
// Consume ids that refer to a namespace, module, or type
//-------------------------------------------------------------------------

[<RequireQualifiedAccess>]
type ShouldNotifySink =
| Yes
| No

/// Perform name resolution for an identifier which must resolve to be a module or namespace.
let rec ResolveLongIdentAsModuleOrNamespace sink (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl =
let rec ResolveLongIdentAsModuleOrNamespace sink (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl notifySink =
if first && id.idText = MangledGlobalName then
match rest with
| [] ->
error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange))
| id2 :: rest2 ->
ResolveLongIdentAsModuleOrNamespace sink amap m false FullyQualified nenv ad id2 rest2 isOpenDecl
ResolveLongIdentAsModuleOrNamespace sink amap m false FullyQualified nenv ad id2 rest2 isOpenDecl notifySink
else
let notFoundAux (id: Ident) depth error (tcrefs: TyconRef seq) =
let suggestNames (addToBuffer: string -> unit) =
Expand Down Expand Up @@ -2432,16 +2437,17 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (amap: Import.ImportMap) m firs
modrefs
|> List.map (fun modref ->
if IsEntityAccessible amap m ad modref then
notifyNameResolution modref id.idRange
if notifySink = ShouldNotifySink.Yes then
notifyNameResolution modref id.idRange
look 1 modref rest
else
raze (namespaceOrModuleNotFound.Force()))
|> List.reduce AddResults
| _ -> raze (namespaceOrModuleNotFound.Force())

// Note - 'rest' is annotated due to a bug currently in Unity (see: https://github.com/dotnet/fsharp/pull/7427)
let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f =
match ResolveLongIdentAsModuleOrNamespace sink amap m true fullyQualified nenv ad id [] isOpenDecl with
let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl notifySink f =
match ResolveLongIdentAsModuleOrNamespace sink amap m true fullyQualified nenv ad id [] isOpenDecl notifySink with
| Result modrefs ->
match rest with
| [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), id.idRange))
Expand Down Expand Up @@ -3067,7 +3073,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified
// Otherwise modules are searched first. REVIEW: modules and types should be searched together.
// For each module referenced by 'id', search the module as if it were an F# module and/or a .NET namespace.
let moduleSearch ad () =
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest isOpenDecl
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest isOpenDecl ShouldNotifySink.No
(ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad)

// REVIEW: somewhat surprisingly, this shows up on performance traces, with tcrefs non-nil.
Expand Down Expand Up @@ -3258,7 +3264,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa
ResolutionInfo.SendEntityPathToSink (sink, ncenv, nenv, ItemOccurence.Pattern, ad, res, ResultTyparChecker(fun () -> true))
Item.Types (id.idText, [ mkAppTy tcref [] ])
| _ ->
match ResolveLongIdentAsModuleOrNamespace sink ncenv.amap id.idRange true fullyQualified nenv ad id [] false with
match ResolveLongIdentAsModuleOrNamespace sink ncenv.amap id.idRange true fullyQualified nenv ad id [] false ShouldNotifySink.Yes with
| Result ((_, mref, _) :: _) ->
let res = ResolutionInfo.Empty.AddEntity (id.idRange, mref)
ResolutionInfo.SendEntityPathToSink (sink, ncenv, nenv, ItemOccurence.Pattern, ad, res, ResultTyparChecker(fun () -> true))
Expand All @@ -3271,7 +3277,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa
// Long identifiers in patterns
else
let moduleSearch ad () =
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest false
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest false ShouldNotifySink.Yes
(ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad)

let tyconSearch ad =
Expand Down Expand Up @@ -3494,12 +3500,12 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full
NoResultsOrUsefulErrors

let modulSearch =
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AllResults ncenv.amap m2 fullyQualified nenv ad id rest false
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AllResults ncenv.amap m2 fullyQualified nenv ad id rest false ShouldNotifySink.Yes
(ResolveTypeLongIdentInModuleOrNamespace sink nenv ncenv typeNameResInfo ad genOk)
|?> List.concat

let modulSearchFailed() =
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AllResults ncenv.amap m2 fullyQualified nenv AccessibleFromSomeFSharpCode id rest false
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AllResults ncenv.amap m2 fullyQualified nenv AccessibleFromSomeFSharpCode id rest false ShouldNotifySink.Yes
(ResolveTypeLongIdentInModuleOrNamespace sink nenv ncenv typeNameResInfo.DropStaticArgsInfo AccessibleFromSomeFSharpCode genOk)
|?> List.concat

Expand Down Expand Up @@ -3710,7 +3716,7 @@ let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFi
match lid with
| [] -> NoResultsOrUsefulErrors
| id2 :: rest2 ->
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id2 rest2 false
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id2 rest2 false ShouldNotifySink.Yes
(ResolveFieldInModuleOrNamespace ncenv nenv ad)

let resInfo, item, rest =
Expand Down Expand Up @@ -3823,7 +3829,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid =
match lid with
| [] -> NoResultsOrUsefulErrors
| modOrNsId :: rest ->
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap modOrNsId.idRange OpenQualified nenv ad modOrNsId rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad)
ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap modOrNsId.idRange OpenQualified nenv ad modOrNsId rest false ShouldNotifySink.Yes (ResolveFieldInModuleOrNamespace ncenv nenv ad)
|?> List.map (fun (_, FieldResolution(rfinfo, _), restAfterField) ->
let fieldId = rest.[ rest.Length - restAfterField.Length - 1 ]
fieldId, Item.RecdField rfinfo, restAfterField)
Expand Down
7 changes: 7 additions & 0 deletions src/Compiler/Checking/NameResolution.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -598,6 +598,12 @@ type AfterResolution =
(MethInfo * PropInfo option * TyparInstantiation -> unit) *
(unit -> unit)

/// Indicates whether we want to report found items to the name resolution sink
[<RequireQualifiedAccess>]
type ShouldNotifySink =
| Yes
| No

/// Temporarily redirect reporting of name resolution and type checking results
val internal WithNewTypecheckResultsSink: ITypecheckResultsSink * TcResultsSink -> System.IDisposable

Expand Down Expand Up @@ -684,6 +690,7 @@ val internal ResolveLongIdentAsModuleOrNamespace:
id: Ident ->
rest: Ident list ->
isOpenDecl: bool ->
notifySink: ShouldNotifySink ->
ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list>

/// Resolve a long identifier to an object constructor.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -600,3 +600,57 @@ type internal SomeType() =
findAllReferences (expectToFind <| method1Locations())
}

[<Fact>]
let ``Module with the same name as type`` () =
let source = """
module Foo

type MyType =
static member Two = 1

let x = MyType.Two

module MyType = do () // <-- Extra module with the same name as the type

let y = MyType.Two
"""

let fileName, options, checker = singleFileChecker source

let symbolUse = getSymbolUse fileName source "MyType" options checker |> Async.RunSynchronously

checker.FindBackgroundReferencesInFile(fileName, options, symbolUse.Symbol, fastCheck = true)
|> Async.RunSynchronously
|> expectToFind [
fileName, 4, 5, 11
fileName, 7, 8, 14
fileName, 11, 8, 14
]

[<Fact>]
let ``Module with the same name as type part 2`` () =
let source = """
module Foo

module MyType =

let Three = 7

type MyType =
static member Two = 1

let x = MyType.Two

let y = MyType.Three
"""

let fileName, options, checker = singleFileChecker source

let symbolUse = getSymbolUse fileName source "MyType" options checker |> Async.RunSynchronously

checker.FindBackgroundReferencesInFile(fileName, options, symbolUse.Symbol, fastCheck = true)
|> Async.RunSynchronously
|> expectToFind [
fileName, 4, 7, 13
fileName, 13, 8, 14
]
3 changes: 1 addition & 2 deletions tests/service/EditorTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1574,15 +1574,14 @@ let _ = Threading.Buzz = null
su.Symbol.ToString(), (r.StartLine, r.StartColumn, r.EndLine, r.EndColumn))
|> Array.distinct
|> shouldEqual
// note: these "System" sysbol uses are not duplications because each of them corresponts to different namespaces
// note: these "System" and "Threading" symbol uses are not duplications because each of them corresponds to different namespaces
[|("System", (2, 5, 2, 11))
("Threading", (2, 12, 2, 21))
("System", (3, 5, 3, 11))
("System", (5, 7, 5, 13))
("Threading", (5, 14, 5, 23))
("Tasks", (5, 24, 5, 29))
("val op_Equality", (6, 23, 6, 24))
("Threading", (6, 8, 6, 17))
("Test", (1, 0, 1, 0))|]

[<Test>]
Expand Down
23 changes: 13 additions & 10 deletions tests/service/ProjectAnalysisTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1482,10 +1482,11 @@ let ``Test project 5 all symbols`` () =
let allUsesOfAllSymbols =
wholeProjectResults.GetAllUsesOfAllSymbols()

|> Array.map (fun su -> su.Symbol.ToString(), su.Symbol.FullName, Project5.cleanFileName su.FileName, tupsZ su.Range, attribsOfSymbolUse su)
|> Seq.map (fun su -> su.Symbol.ToString(), su.Symbol.FullName, Project5.cleanFileName su.FileName, tupsZ su.Range, attribsOfSymbolUse su)
|> Set

allUsesOfAllSymbols |> shouldEqual
[|("symbol Even", "Even", "file1", ((4, 6), (4, 10)), ["defn"]);
(Set [("symbol Even", "Even", "file1", ((4, 6), (4, 10)), ["defn"]);
("symbol Odd", "Odd", "file1", ((4, 11), (4, 14)), ["defn"]);
("val input", "input", "file1", ((4, 17), (4, 22)), ["defn"]);
("val op_Equality", "Microsoft.FSharp.Core.Operators.(=)", "file1",
Expand Down Expand Up @@ -1539,7 +1540,7 @@ let ``Test project 5 all symbols`` () =
("val str", "str", "file1", ((22, 38), (22, 41)), []);
("val parseNumeric", "ActivePatterns.parseNumeric", "file1",
((19, 4), (19, 16)), ["defn"]);
("ActivePatterns", "ActivePatterns", "file1", ((1, 7), (1, 21)), ["defn"])|]
("ActivePatterns", "ActivePatterns", "file1", ((1, 7), (1, 21)), ["defn"])])

[<Test>]
let ``Test complete active patterns' exact ranges from uses of symbols`` () =
Expand Down Expand Up @@ -2764,11 +2765,12 @@ let ``Test Project17 all symbols`` () =
let allUsesOfAllSymbols =
wholeProjectResults.GetAllUsesOfAllSymbols()

|> Array.map (fun su -> su.Symbol.ToString(), su.Symbol.DisplayName, Project17.cleanFileName su.FileName, tups su.Range, attribsOfSymbolUse su, attribsOfSymbol su.Symbol)
|> Seq.map (fun su -> su.Symbol.ToString(), su.Symbol.DisplayName, Project17.cleanFileName su.FileName, tups su.Range, attribsOfSymbolUse su, attribsOfSymbol su.Symbol)
|> Set

allUsesOfAllSymbols
|> shouldEqual
[|("Microsoft", "Microsoft", "file1", ((4, 8), (4, 17)), [], ["namespace"]);
|> shouldEqual (Set
[("Microsoft", "Microsoft", "file1", ((4, 8), (4, 17)), [], ["namespace"]);
("Collections", "Collections", "file1", ((4, 25), (4, 36)), [], ["namespace"]);
("FSharp", "FSharp", "file1", ((4, 18), (4, 24)), [], ["namespace"]);
("FSharpList`1", "List", "file1", ((4, 8), (4, 41)), [], ["union"]);
Expand Down Expand Up @@ -2808,7 +2810,7 @@ let ``Test Project17 all symbols`` () =
("property HelpLink", "HelpLink", "file1", ((10, 31), (10, 41)), [],
["slot"; "member"; "prop"]);
("val f3", "f3", "file1", ((10, 4), (10, 6)), ["defn"], ["val"]);
("Impl", "Impl", "file1", ((2, 7), (2, 11)), ["defn"], ["module"])|]
("Impl", "Impl", "file1", ((2, 7), (2, 11)), ["defn"], ["module"])])


//-----------------------------------------------------------------------------------------
Expand Down Expand Up @@ -2906,10 +2908,11 @@ let ``Test Project19 all symbols`` () =
let allUsesOfAllSymbols =
wholeProjectResults.GetAllUsesOfAllSymbols()

|> Array.map (fun su -> su.Symbol.ToString(), su.Symbol.DisplayName, Project19.cleanFileName su.FileName, tups su.Range, attribsOfSymbolUse su, attribsOfSymbol su.Symbol)
|> Seq.map (fun su -> su.Symbol.ToString(), su.Symbol.DisplayName, Project19.cleanFileName su.FileName, tups su.Range, attribsOfSymbolUse su, attribsOfSymbol su.Symbol)
|> Set

allUsesOfAllSymbols |> shouldEqual
[|("field EnumCase1", "EnumCase1", "file1", ((4, 14), (4, 23)), ["defn"],
(Set [("field EnumCase1", "EnumCase1", "file1", ((4, 14), (4, 23)), ["defn"],
["field"; "static"; "1"]);
("field EnumCase2", "EnumCase2", "file1", ((4, 30), (4, 39)), ["defn"],
["field"; "static"; "2"]);
Expand All @@ -2935,7 +2938,7 @@ let ``Test Project19 all symbols`` () =
("field Monday", "Monday", "file1", ((10, 8), (10, 31)), [],
["field"; "static"; "1"]);
("val s", "s", "file1", ((10, 4), (10, 5)), ["defn"], ["val"]);
("Impl", "Impl", "file1", ((2, 7), (2, 11)), ["defn"], ["module"])|]
("Impl", "Impl", "file1", ((2, 7), (2, 11)), ["defn"], ["module"])])



Expand Down