Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Don't add "opens" for parent namespaces to tc environments #10386

Merged
merged 6 commits into from
Nov 4, 2020
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
10 changes: 5 additions & 5 deletions src/fsharp/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2175,7 +2175,7 @@ module MutRecBindingChecking =
/// Compute the active environments within each nested module.
let TcMutRecDefns_ComputeEnvs getTyconOpt getVals (cenv: cenv) report scopem m envInitial mutRecShape =
(envInitial, mutRecShape) ||> MutRecShapes.computeEnvs
(fun envAbove (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec)) -> MakeInnerEnvWithAcc envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind)
(fun envAbove (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec)) -> MakeInnerEnvWithAcc true envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind)
(fun envAbove decls ->

// Collect the type definitions, exception definitions, modules and "open" declarations
Expand Down Expand Up @@ -3202,7 +3202,7 @@ module EstablishTypeDefinitionCores =
CheckForDuplicateConcreteType envInitial id.idText im
CheckNamespaceModuleOrTypeName cenv.g id

let envForDecls, mtypeAcc = MakeInnerEnv envInitial id modKind
let envForDecls, mtypeAcc = MakeInnerEnv true envInitial id modKind
let mty = Construct.NewEmptyModuleOrNamespaceType modKind
let doc = xml.ToXmlDoc(true, Some [])
let mspec = Construct.NewModuleOrNamespace (Some envInitial.eCompPath) vis id doc modAttrs (MaybeLazy.Strict mty)
Expand Down Expand Up @@ -4341,7 +4341,7 @@ module EstablishTypeDefinitionCores =
(envInitial, withEntities) ||> MutRecShapes.computeEnvs
(fun envAbove (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec)) ->
PublishModuleDefn cenv envAbove mspec
MakeInnerEnvWithAcc envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind)
MakeInnerEnvWithAcc true envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind)
(fun envAbove _ -> envAbove)

// Updates the types of the modules to contain the contents so far, which now includes the nested modules and types
Expand Down Expand Up @@ -5212,7 +5212,7 @@ and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id, modKind,
let endm = m.EndRange // use end of range for errors

// Create the module type that will hold the results of type checking....
let envForModule, mtypeAcc = MakeInnerEnv env id modKind
let envForModule, mtypeAcc = MakeInnerEnv true env id modKind

// Now typecheck the signature, using mutation to fill in the submodule description.
let! envAtEnd = TcSignatureElements cenv parent endm envForModule xml None defs
Expand Down Expand Up @@ -5350,7 +5350,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem

CheckNamespaceModuleOrTypeName cenv.g id

let envForModule, mtypeAcc = MakeInnerEnv env id modKind
let envForModule, mtypeAcc = MakeInnerEnv true env id modKind

// Create the new module specification to hold the accumulated results of the type of the module
// Also record this in the environment as the accumulator
Expand Down
15 changes: 10 additions & 5 deletions src/fsharp/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -449,22 +449,26 @@ let UnifyTypes cenv (env: TcEnv) m actualTy expectedTy =
ConstraintSolver.AddCxTypeEqualsType env.eContextInfo env.DisplayEnv cenv.css m (tryNormalizeMeasureInType cenv.g actualTy) (tryNormalizeMeasureInType cenv.g expectedTy)

/// Make an environment suitable for a module or namespace. Does not create a new accumulator but uses one we already have/
let MakeInnerEnvWithAcc env nm mtypeAcc modKind =
let MakeInnerEnvWithAcc addOpenToNameEnv env nm mtypeAcc modKind =
let path = env.ePath @ [nm]
let cpath = env.eCompPath.NestedCompPath nm.idText modKind
{ env with
ePath = path
eCompPath = cpath
eAccessPath = cpath
eAccessRights = ComputeAccessRights cpath env.eInternalsVisibleCompPaths env.eFamilyType // update this computed field
eNameResEnv = { env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid path) }
eNameResEnv =
if addOpenToNameEnv then
{ env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid path) }
else
env.NameEnv
eModuleOrNamespaceTypeAccumulator = mtypeAcc }

/// Make an environment suitable for a module or namespace, creating a new accumulator.
let MakeInnerEnv env nm modKind =
let MakeInnerEnv addOpenToNameEnv env nm modKind =
// Note: here we allocate a new module type accumulator
let mtypeAcc = ref (Construct.NewEmptyModuleOrNamespaceType modKind)
MakeInnerEnvWithAcc env nm mtypeAcc modKind, mtypeAcc
MakeInnerEnvWithAcc addOpenToNameEnv env nm mtypeAcc modKind, mtypeAcc

/// Make an environment suitable for processing inside a type definition
let MakeInnerEnvForTyconRef env tcref isExtrinsicExtension =
Expand Down Expand Up @@ -502,7 +506,8 @@ let LocateEnv ccu env enclosingNamespacePath =
eAccessPath = cpath
// update this computed field
eAccessRights = ComputeAccessRights cpath env.eInternalsVisibleCompPaths env.eFamilyType }
let env = List.fold (fun env id -> MakeInnerEnv env id Namespace |> fst) env enclosingNamespacePath
let env = List.fold (fun env id -> MakeInnerEnv false env id Namespace |> fst) env enclosingNamespacePath
let env = { env with eNameResEnv = { env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid env.ePath) } }
env


Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/CheckExpressions.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -610,11 +610,11 @@ val MakeInnerEnvForTyconRef: env: TcEnv -> tcref: TyconRef -> isExtrinsicExtensi

/// Return a new environment suitable for processing declarations in the interior of a module definition
/// including creating an accumulator for the module type.
val MakeInnerEnv: env: TcEnv -> nm: Ident -> modKind: ModuleOrNamespaceKind -> TcEnv * ModuleOrNamespaceType ref
val MakeInnerEnv: addOpenToNameEnv: bool -> env: TcEnv -> nm: Ident -> modKind: ModuleOrNamespaceKind -> TcEnv * ModuleOrNamespaceType ref

/// Return a new environment suitable for processing declarations in the interior of a module definition
/// given that the accumulator for the module type already exisits.
val MakeInnerEnvWithAcc: env: TcEnv -> nm: Ident -> mtypeAcc: ModuleOrNamespaceType ref -> modKind: ModuleOrNamespaceKind -> TcEnv
val MakeInnerEnvWithAcc: addOpenToNameEnv: bool -> env: TcEnv -> nm: Ident -> mtypeAcc: ModuleOrNamespaceType ref -> modKind: ModuleOrNamespaceKind -> TcEnv

/// Produce a post-generalization type scheme for a simple type where no type inference generalization
/// is appplied.
Expand Down
13 changes: 13 additions & 0 deletions tests/service/Common.fs
Original file line number Diff line number Diff line change
Expand Up @@ -395,6 +395,19 @@ let assertHasSymbolUsages (names: string list) (results: FSharpCheckFileResults)
for name in names do
Assert.That(Set.contains name symbolNames, name)


let findSymbolUseByName (name: string) (results: FSharpCheckFileResults) =
getSymbolUses results
|> Array.find (fun symbolUse ->
match getSymbolName symbolUse.Symbol with
| Some symbolName -> symbolName = name
| _ -> false)

let findSymbolByName (name: string) (results: FSharpCheckFileResults) =
let symbolUse = findSymbolUseByName name results
symbolUse.Symbol


let getRangeCoords (r: range) =
(r.StartLine, r.StartColumn), (r.EndLine, r.EndColumn)

Expand Down
36 changes: 36 additions & 0 deletions tests/service/Symbols.fs
Original file line number Diff line number Diff line change
Expand Up @@ -122,3 +122,39 @@ let x = 123
|> Option.orElseWith (fun _ -> failwith "Could not get symbol")
|> Option.map (fun su -> su.Symbol :?> FSharpMemberOrFunctionOrValue)
|> Option.iter (fun symbol -> symbol.Attributes.Count |> shouldEqual 1)

module Types =
[<Test>]
let ``FSharpType.Print parent namespace qualifiers`` () =
let _, checkResults = getParseAndCheckResults """
namespace Ns1.Ns2
type T() = class end
type A = T

namespace Ns1.Ns3
type B = Ns1.Ns2.T

namespace Ns1.Ns4
open Ns1.Ns2
type C = Ns1.Ns2.T

namespace Ns1.Ns5
open Ns1
type D = Ns1.Ns2.T

namespace Ns1.Ns2.Ns6
type E = Ns1.Ns2.T
"""
[| "A", "T"
"B", "Ns1.Ns2.T"
"C", "T"
"D", "Ns2.T"
"E", "Ns1.Ns2.T" |]
|> Array.iter (fun (symbolName, expectedPrintedType) ->
let symbolUse = findSymbolUseByName symbolName checkResults
match symbolUse.Symbol with
| :? FSharpEntity as entity ->
entity.AbbreviatedType.Format(symbolUse.DisplayContext)
|> should equal expectedPrintedType

| _ -> failwithf "Couldn't get entity: %s" symbolName)