From 14fd06fde350fda895a76797eca092bdce22f4ab Mon Sep 17 00:00:00 2001 From: TIHan Date: Fri, 19 Jun 2020 23:19:49 -0700 Subject: [PATCH 01/89] Allow using nested types in unqualified scenarios --- src/fsharp/InfoReader.fs | 2 - src/fsharp/NameResolution.fs | 565 ++++++++++-------- .../Compiler/Language/OpenStaticClasses.fs | 103 ++++ 3 files changed, 414 insertions(+), 256 deletions(-) diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index 222a2557890..d7256a1a2fd 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -922,5 +922,3 @@ let PropTypOfEventInfo (infoReader: InfoReader) m ad (einfo: EventInfo) = let delTy = einfo.GetDelegateType(amap, m) let argsTy = ArgsTypOfEventInfo infoReader m ad einfo mkIEventType g delTy argsTy - - diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 43d7d1e6f19..d858914c15c 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -770,39 +770,322 @@ let AddUnionCases2 bulkAddMode (eUnqualifiedItems: UnqualifiedItems) (ucrefs: Un let item = Item.UnionCase(GeneralizeUnionCaseRef ucref, false) acc.Add (ucref.CaseName, item)) +let GetStaticMethodItems infoReader nenv ad m ty = + let methGroups = + AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty + |> List.groupBy (fun m -> m.LogicalName) + + seq { + for (methName, methGroup) in methGroups do + let methGroup = + methGroup + |> List.filter (fun m -> + not (m.IsInstance || m.IsClassConstructor || m.IsConstructor) && typeEquiv infoReader.amap.g m.ApparentEnclosingType ty) + if not methGroup.IsEmpty then + yield KeyValuePair(methName, Item.MethodGroup(methName, methGroup, None)) + } + +let GetStaticPropertyItems infoReader nenv ad m ty = + let propInfos = + AllPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty + |> List.groupBy (fun m -> m.PropertyName) + + seq { + for (propName, propInfos) in propInfos do + let propInfos = + propInfos + |> List.filter (fun m -> + m.IsStatic && typeEquiv infoReader.amap.g m.ApparentEnclosingType ty) + for propInfo in propInfos do + yield KeyValuePair(propName , Item.Property(propName,[propInfo])) + } + +let GetStaticFieldItems (infoReader: InfoReader) ad m ty = + let fields = + infoReader.GetILFieldInfosOfType(None, ad, m, ty) + |> List.groupBy (fun f -> f.FieldName) + + seq { + for (fieldName, fieldInfos) in fields do + let fieldInfos = fieldInfos |> List.filter (fun fi -> fi.IsStatic) + for fieldInfo in fieldInfos do + yield KeyValuePair(fieldName, Item.ILField(fieldInfo)) + } + +let GetStaticEventItems (infoReader: InfoReader) ad m ty = + let events = + infoReader.GetEventInfosOfType(None, ad, m, ty) + |> List.groupBy (fun e -> e.EventName) + + seq { + for (eventName, eventInfos) in events do + let eventInfos = eventInfos |> List.filter (fun e -> e.IsStatic) + for eventInfo in eventInfos do + yield KeyValuePair(eventName, Item.Event(eventInfo)) + } + +//------------------------------------------------------------------------- +// TypeNameResolutionInfo +//------------------------------------------------------------------------- + +/// Indicates whether we are resolving type names to type definitions or to constructor methods. +type TypeNameResolutionFlag = + | ResolveTypeNamesToCtors + | ResolveTypeNamesToTypeRefs + +[] +[] +/// Represents information about the generic argument count of a type name when resolving it. +/// +/// In some situations we resolve "List" to any type definition with that name regardless of the number +/// of generic arguments. In others, we know precisely how many generic arguments are needed. +type TypeNameResolutionStaticArgsInfo = + /// Indicates indefinite knowledge of type arguments + | Indefinite + /// Indicates definite knowledge of type arguments + | Definite of int + + /// Indicates definite knowledge of empty type arguments + static member DefiniteEmpty = TypeNameResolutionStaticArgsInfo.Definite 0 + + static member FromTyArgs (numTyArgs: int) = TypeNameResolutionStaticArgsInfo.Definite numTyArgs + + member x.HasNoStaticArgsInfo = match x with TypeNameResolutionStaticArgsInfo.Indefinite -> true | _-> false + + member x.NumStaticArgs = match x with TypeNameResolutionStaticArgsInfo.Indefinite -> 0 | TypeNameResolutionStaticArgsInfo.Definite n -> n + + // Get the first possible mangled name of the type, assuming the args are generic args + member x.MangledNameForType nm = + if x.NumStaticArgs = 0 || TryDemangleGenericNameAndPos nm <> ValueNone then nm + else nm + "`" + string x.NumStaticArgs + +[] +/// Represents information which guides name resolution of types. +type TypeNameResolutionInfo = + | TypeNameResolutionInfo of TypeNameResolutionFlag * TypeNameResolutionStaticArgsInfo + + static member Default = TypeNameResolutionInfo (ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.Indefinite) + static member ResolveToTypeRefs statResInfo = TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs, statResInfo) + member x.StaticArgsInfo = match x with TypeNameResolutionInfo(_, staticResInfo) -> staticResInfo + member x.ResolutionFlag = match x with TypeNameResolutionInfo(flag, _) -> flag + member x.DropStaticArgsInfo = match x with TypeNameResolutionInfo(flag2, _) -> TypeNameResolutionInfo(flag2, TypeNameResolutionStaticArgsInfo.Indefinite) + +/// A flag which indicates if direct references to generated provided types are allowed. Normally these +/// are disallowed. +[] +type PermitDirectReferenceToGeneratedType = + | Yes + | No + +#if !NO_EXTENSIONTYPING + +/// Check for direct references to generated provided types. +let CheckForDirectReferenceToGeneratedType (tcref: TyconRef, genOk, m) = + match genOk with + | PermitDirectReferenceToGeneratedType.Yes -> () + | PermitDirectReferenceToGeneratedType.No -> + match tcref.TypeReprInfo with + | TProvidedTypeExtensionPoint info when not info.IsErased -> + if ExtensionTyping.IsGeneratedTypeDirectReference (info.ProvidedType, m) then + error (Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName), m)) + | _ -> () + +/// This adds a new entity for a lazily discovered provided type into the TAST structure. +let AddEntityForProvidedType (amap: Import.ImportMap, modref: ModuleOrNamespaceRef, resolutionEnvironment, st: Tainted, m) = + let importProvidedType t = Import.ImportProvidedType amap m t + let isSuppressRelocate = amap.g.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate), m) + let tycon = Construct.NewProvidedTycon(resolutionEnvironment, st, importProvidedType, isSuppressRelocate, m) + modref.ModuleOrNamespaceType.AddProvidedTypeEntity tycon + let tcref = modref.NestedTyconRef tycon + System.Diagnostics.Debug.Assert(modref.TryDeref.IsSome) + tcref + + +/// Given a provided type or provided namespace, resolve the type name using the type provider API. +/// If necessary, incorporate the provided type or namespace into the entity. +let ResolveProvidedTypeNameInEntity (amap, m, typeName, modref: ModuleOrNamespaceRef) = + match modref.TypeReprInfo with + | TProvidedNamespaceExtensionPoint(resolutionEnvironment, resolvers) -> + match modref.Deref.PublicPath with + | Some(PubPath path) -> + resolvers + |> List.choose (fun r-> ExtensionTyping.TryResolveProvidedType(r, m, path, typeName)) + |> List.map (fun st -> AddEntityForProvidedType (amap, modref, resolutionEnvironment, st, m)) + | None -> [] + + // We have a provided type, look up its nested types (populating them on-demand if necessary) + | TProvidedTypeExtensionPoint info -> + let sty = info.ProvidedType + let resolutionEnvironment = info.ResolutionEnvironment + +#if DEBUG + if resolutionEnvironment.showResolutionMessages then + dprintfn "resolving name '%s' in TProvidedTypeExtensionPoint '%s'" typeName (sty.PUntaint((fun sty -> sty.FullName), m)) +#endif + + match sty.PApply((fun sty -> sty.GetNestedType typeName), m) with + | Tainted.Null -> + //if staticResInfo.NumStaticArgs > 0 then + // error(Error(FSComp.SR.etNestedProvidedTypesDoNotTakeStaticArgumentsOrGenericParameters(), m)) + [] + | nestedSty -> + [AddEntityForProvidedType (amap, modref, resolutionEnvironment, nestedSty, m) ] + | _ -> [] +#endif + +//------------------------------------------------------------------------- +// Resolve (possibly mangled) type names in entity +//------------------------------------------------------------------------- + +/// Qualified lookups of type names where the number of generic arguments is known +/// from context, e.g. Module.Type. The full names suh as ``List`1`` can +/// be used to qualify access if needed +let LookupTypeNameInEntityHaveArity nm (staticResInfo: TypeNameResolutionStaticArgsInfo) (mty: ModuleOrNamespaceType) = + let attempt1 = mty.TypesByMangledName.TryFind (staticResInfo.MangledNameForType nm) + match attempt1 with + | None -> mty.TypesByMangledName.TryFind nm + | _ -> attempt1 + +/// Implements unqualified lookups of type names where the number of generic arguments is NOT known +/// from context. +// +// This is used in five places: +// - static member lookups, e.g. MyType.StaticMember(3) +// - e.g. MyModule.MyType.StaticMember(3) +// - type-qualified field names, e.g. { RecordType.field = 3 } +// - type-qualified constructor names, e.g. match x with UnionType.A -> 3 +// - identifiers to constructors for better error messages, e.g. 'String(3)' after 'open System' +// - the special single-constructor rule in TcTyconCores +// +// Because of the potential ambiguity multiple results can be returned. +// Explicit type annotations can be added where needed to specify the generic arity. +// +// In theory the full names such as ``RecordType`1`` can +// also be used to qualify access if needed, though this is almost never needed. +let LookupTypeNameNoArity nm (byDemangledNameAndArity: LayeredMap) (byAccessNames: LayeredMultiMap) = + match TryDemangleGenericNameAndPos nm with + | ValueSome pos -> + let demangled = DecodeGenericTypeName pos nm + match byDemangledNameAndArity.TryGetValue demangled with + | true, res -> [res] + | _ -> + match byAccessNames.TryGetValue nm with + | true, res -> res + | _ -> [] + | _ -> + byAccessNames.[nm] + +/// Qualified lookup of type names in an entity +let LookupTypeNameInEntityNoArity m nm (mtyp: ModuleOrNamespaceType) = + LookupTypeNameNoArity nm (mtyp.TypesByDemangledNameAndArity m) mtyp.TypesByAccessNames + +/// Lookup a type name in an entity. +let LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo: TypeNameResolutionStaticArgsInfo, modref: ModuleOrNamespaceRef) = + let mtyp = modref.ModuleOrNamespaceType + let tcrefs = + match staticResInfo with + | TypeNameResolutionStaticArgsInfo.Indefinite -> + LookupTypeNameInEntityNoArity m nm mtyp + |> List.map modref.NestedTyconRef + | TypeNameResolutionStaticArgsInfo.Definite _ -> + match LookupTypeNameInEntityHaveArity nm staticResInfo mtyp with + | Some tycon -> [modref.NestedTyconRef tycon] + | None -> [] +#if !NO_EXTENSIONTYPING + let tcrefs = + match tcrefs with + | [] -> ResolveProvidedTypeNameInEntity (amap, m, nm, modref) + | _ -> tcrefs +#else + amap |> ignore +#endif + let tcrefs = tcrefs |> List.filter (IsEntityAccessible amap m ad) + tcrefs + +/// Get all the accessible nested types of an existing type. +let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) (ad, optFilter, staticResInfo, checkForGenerated, m) ty = + let g = amap.g + infoReader.GetPrimaryTypeHierarchy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> + match ty with + | AppTy g (tcref, tinst) -> + let tycon = tcref.Deref + let mty = tycon.ModuleOrNamespaceType + // No dotting through type generators to get to a nested type! +#if !NO_EXTENSIONTYPING + if checkForGenerated then + CheckForDirectReferenceToGeneratedType (tcref, PermitDirectReferenceToGeneratedType.No, m) +#else + checkForGenerated |> ignore +#endif + + match optFilter with + | Some nm -> + LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo, tcref) + |> List.map (fun tcref -> (tinst, tcref)) + | None -> +#if !NO_EXTENSIONTYPING + match tycon.TypeReprInfo with + | TProvidedTypeExtensionPoint info -> + [ for nestedType in info.ProvidedType.PApplyArray((fun sty -> sty.GetNestedTypes()), "GetNestedTypes", m) do + let nestedTypeName = nestedType.PUntaint((fun t -> t.Name), m) + yield! + LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nestedTypeName, staticResInfo, tcref) + |> List.map (fun tcref -> (tinst, tcref)) ] + + | _ -> +#endif + mty.TypesByAccessNames.Values + |> List.choose (fun entity -> + let tcref = tcref.NestedTyconRef entity + if IsEntityAccessible amap m ad tcref then Some (tinst, tcref) else None) + | _ -> []) + +/// Make a type that refers to a nested type. +/// +/// Handle the .NET/C# business where nested generic types implicitly accumulate the type parameters +/// from their enclosing types. +let MakeNestedType (ncenv: NameResolver) (tinst: TType list) m (tcrefNested: TyconRef) = + let tps = List.skip tinst.Length (tcrefNested.Typars m) + let tinstNested = ncenv.InstantiationGenerator m tps + mkAppTy tcrefNested (tinst @ tinstNested) + +/// Get all the accessible nested types of an existing type. +let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, checkForGenerated, m) ty = + GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty + |> List.map (fun (tinst, tcref) -> MakeNestedType ncenv tinst m tcref) + +let MakeNestedTypeNoInstantiation (tinst: TType list) m (tcrefNested: TyconRef) = + let tps = List.skip tinst.Length (tcrefNested.Typars m) + let tinstNested = tps |> List.map mkTyparTy + mkAppTy tcrefNested (tinst @ tinstNested) + +let GetNestedTypeItemsOfType infoReader amap ad m ty = + let nestedTcrefGroups = + GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) ty + |> List.groupBy (fun (_, m) -> DemangleGenericTypeName m.LogicalName) + + seq { + for (nestedTypeName, nestedTypeGroups) in nestedTcrefGroups do + let nested = + nestedTypeGroups + |> List.map (fun (_, tcref) -> tcref) + yield KeyValuePair(nestedTypeName, Item.UnqualifiedType(nested)) + } + let AddStaticContentOfTyconRefToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (tcref:TyconRef) = // If OpenStaticClasses is not enabled then don't do this if amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses then let ty = generalizedTyconRef tcref let infoReader = InfoReader(g,amap) + let items = - [| let methGroups = - AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty - |> List.groupBy (fun m -> m.LogicalName) - - for (methName, methGroup) in methGroups do - let methGroup = methGroup |> List.filter (fun m -> not m.IsInstance && not m.IsClassConstructor) - if not methGroup.IsEmpty then - yield KeyValuePair(methName, Item.MethodGroup(methName, methGroup, None)) - - let propInfos = - AllPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty - |> List.groupBy (fun m -> m.PropertyName) - - for (propName, propInfos) in propInfos do - let propInfos = propInfos |> List.filter (fun m -> m.IsStatic) - for propInfo in propInfos do - yield KeyValuePair(propName , Item.Property(propName,[propInfo])) - - let fields = - infoReader.GetILFieldInfosOfType(None, ad, m, ty) - |> List.groupBy (fun f -> f.FieldName) - - for (fieldName, fieldInfos) in fields do - let fieldInfos = fieldInfos |> List.filter (fun fi -> fi.IsStatic) - for fieldInfo in fieldInfos do - yield KeyValuePair(fieldName, Item.ILField(fieldInfo)) - |] + [| + yield! GetNestedTypeItemsOfType infoReader amap ad m ty + yield! GetStaticMethodItems infoReader nenv ad m ty + yield! GetStaticPropertyItems infoReader nenv ad m ty + yield! GetStaticFieldItems infoReader ad m ty + yield! GetStaticEventItems infoReader ad m ty + |] { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } else @@ -1145,65 +1428,9 @@ let AtMostOneResultQuery query2 res1 = let inline (+++) res1 query2 = AtMostOneResultQuery query2 res1 //------------------------------------------------------------------------- -// TypeNameResolutionInfo +// Resolve (possibly mangled) type names in environment //------------------------------------------------------------------------- -/// Indicates whether we are resolving type names to type definitions or to constructor methods. -type TypeNameResolutionFlag = - | ResolveTypeNamesToCtors - | ResolveTypeNamesToTypeRefs - -[] -[] -/// Represents information about the generic argument count of a type name when resolving it. -/// -/// In some situations we resolve "List" to any type definition with that name regardless of the number -/// of generic arguments. In others, we know precisely how many generic arguments are needed. -type TypeNameResolutionStaticArgsInfo = - /// Indicates indefinite knowledge of type arguments - | Indefinite - /// Indicates definite knowledge of type arguments - | Definite of int - - /// Indicates definite knowledge of empty type arguments - static member DefiniteEmpty = TypeNameResolutionStaticArgsInfo.Definite 0 - - static member FromTyArgs (numTyArgs: int) = TypeNameResolutionStaticArgsInfo.Definite numTyArgs - - member x.HasNoStaticArgsInfo = match x with TypeNameResolutionStaticArgsInfo.Indefinite -> true | _-> false - - member x.NumStaticArgs = match x with TypeNameResolutionStaticArgsInfo.Indefinite -> 0 | TypeNameResolutionStaticArgsInfo.Definite n -> n - - // Get the first possible mangled name of the type, assuming the args are generic args - member x.MangledNameForType nm = - if x.NumStaticArgs = 0 || TryDemangleGenericNameAndPos nm <> ValueNone then nm - else nm + "`" + string x.NumStaticArgs - -[] -/// Represents information which guides name resolution of types. -type TypeNameResolutionInfo = - | TypeNameResolutionInfo of TypeNameResolutionFlag * TypeNameResolutionStaticArgsInfo - - static member Default = TypeNameResolutionInfo (ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.Indefinite) - static member ResolveToTypeRefs statResInfo = TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs, statResInfo) - member x.StaticArgsInfo = match x with TypeNameResolutionInfo(_, staticResInfo) -> staticResInfo - member x.ResolutionFlag = match x with TypeNameResolutionInfo(flag, _) -> flag - member x.DropStaticArgsInfo = match x with TypeNameResolutionInfo(flag2, _) -> TypeNameResolutionInfo(flag2, TypeNameResolutionStaticArgsInfo.Indefinite) - - -//------------------------------------------------------------------------- -// Resolve (possibly mangled) type names -//------------------------------------------------------------------------- - -/// Qualified lookups of type names where the number of generic arguments is known -/// from context, e.g. Module.Type. The full names suh as ``List`1`` can -/// be used to qualify access if needed -let LookupTypeNameInEntityHaveArity nm (staticResInfo: TypeNameResolutionStaticArgsInfo) (mty: ModuleOrNamespaceType) = - let attempt1 = mty.TypesByMangledName.TryFind (staticResInfo.MangledNameForType nm) - match attempt1 with - | None -> mty.TypesByMangledName.TryFind nm - | _ -> attempt1 - /// Unqualified lookups of type names where the number of generic arguments is known /// from context, e.g. List. Rebindings due to 'open' may have rebound identifiers. let LookupTypeNameInEnvHaveArity fq nm numTyArgs (nenv: NameResolutionEnv) = @@ -1216,44 +1443,10 @@ let LookupTypeNameInEnvHaveArity fq nm numTyArgs (nenv: NameResolutionEnv) = | None -> nenv.TyconsByAccessNames(fq).TryFind nm |> Option.map List.head | res -> res -/// Implements unqualified lookups of type names where the number of generic arguments is NOT known -/// from context. -// -// This is used in five places: -// - static member lookups, e.g. MyType.StaticMember(3) -// - e.g. MyModule.MyType.StaticMember(3) -// - type-qualified field names, e.g. { RecordType.field = 3 } -// - type-qualified constructor names, e.g. match x with UnionType.A -> 3 -// - identifiers to constructors for better error messages, e.g. 'String(3)' after 'open System' -// - the special single-constructor rule in TcTyconCores -// -// Because of the potential ambiguity multiple results can be returned. -// Explicit type annotations can be added where needed to specify the generic arity. -// -// In theory the full names such as ``RecordType`1`` can -// also be used to qualify access if needed, though this is almost never needed. - -let LookupTypeNameNoArity nm (byDemangledNameAndArity: LayeredMap) (byAccessNames: LayeredMultiMap) = - match TryDemangleGenericNameAndPos nm with - | ValueSome pos -> - let demangled = DecodeGenericTypeName pos nm - match byDemangledNameAndArity.TryGetValue demangled with - | true, res -> [res] - | _ -> - match byAccessNames.TryGetValue nm with - | true, res -> res - | _ -> [] - | _ -> - byAccessNames.[nm] - /// Qualified lookup of type names in the environment let LookupTypeNameInEnvNoArity fq nm (nenv: NameResolutionEnv) = LookupTypeNameNoArity nm (nenv.TyconsByDemangledNameAndArity fq) (nenv.TyconsByAccessNames fq) -/// Qualified lookup of type names in an entity -let LookupTypeNameInEntityNoArity m nm (mtyp: ModuleOrNamespaceType) = - LookupTypeNameNoArity nm (mtyp.TypesByDemangledNameAndArity m) mtyp.TypesByAccessNames - /// Qualified lookup of type names in an entity where we may know a generic argument count let LookupTypeNameInEnvMaybeHaveArity fq nm (typeNameResInfo: TypeNameResolutionInfo) nenv = if typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo then @@ -1261,142 +1454,6 @@ let LookupTypeNameInEnvMaybeHaveArity fq nm (typeNameResInfo: TypeNameResolution else LookupTypeNameInEnvHaveArity fq nm typeNameResInfo.StaticArgsInfo.NumStaticArgs nenv |> Option.toList -/// A flag which indicates if direct references to generated provided types are allowed. Normally these -/// are disallowed. -[] -type PermitDirectReferenceToGeneratedType = - | Yes - | No - - -#if !NO_EXTENSIONTYPING - -/// Check for direct references to generated provided types. -let CheckForDirectReferenceToGeneratedType (tcref: TyconRef, genOk, m) = - match genOk with - | PermitDirectReferenceToGeneratedType.Yes -> () - | PermitDirectReferenceToGeneratedType.No -> - match tcref.TypeReprInfo with - | TProvidedTypeExtensionPoint info when not info.IsErased -> - //printfn "checking direct reference to generated type '%s'" tcref.DisplayName - if ExtensionTyping.IsGeneratedTypeDirectReference (info.ProvidedType, m) then - error (Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName), m)) - | _ -> () - - -/// This adds a new entity for a lazily discovered provided type into the TAST structure. -let AddEntityForProvidedType (amap: Import.ImportMap, modref: ModuleOrNamespaceRef, resolutionEnvironment, st: Tainted, m) = - let importProvidedType t = Import.ImportProvidedType amap m t - let isSuppressRelocate = amap.g.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate), m) - let tycon = Construct.NewProvidedTycon(resolutionEnvironment, st, importProvidedType, isSuppressRelocate, m) - modref.ModuleOrNamespaceType.AddProvidedTypeEntity tycon - let tcref = modref.NestedTyconRef tycon - System.Diagnostics.Debug.Assert(modref.TryDeref.IsSome) - tcref - - -/// Given a provided type or provided namespace, resolve the type name using the type provider API. -/// If necessary, incorporate the provided type or namespace into the entity. -let ResolveProvidedTypeNameInEntity (amap, m, typeName, modref: ModuleOrNamespaceRef) = - match modref.TypeReprInfo with - | TProvidedNamespaceExtensionPoint(resolutionEnvironment, resolvers) -> - match modref.Deref.PublicPath with - | Some(PubPath path) -> - resolvers - |> List.choose (fun r-> ExtensionTyping.TryResolveProvidedType(r, m, path, typeName)) - |> List.map (fun st -> AddEntityForProvidedType (amap, modref, resolutionEnvironment, st, m)) - | None -> [] - - // We have a provided type, look up its nested types (populating them on-demand if necessary) - | TProvidedTypeExtensionPoint info -> - let sty = info.ProvidedType - let resolutionEnvironment = info.ResolutionEnvironment - -#if DEBUG - if resolutionEnvironment.showResolutionMessages then - dprintfn "resolving name '%s' in TProvidedTypeExtensionPoint '%s'" typeName (sty.PUntaint((fun sty -> sty.FullName), m)) -#endif - - match sty.PApply((fun sty -> sty.GetNestedType typeName), m) with - | Tainted.Null -> - //if staticResInfo.NumStaticArgs > 0 then - // error(Error(FSComp.SR.etNestedProvidedTypesDoNotTakeStaticArgumentsOrGenericParameters(), m)) - [] - | nestedSty -> - [AddEntityForProvidedType (amap, modref, resolutionEnvironment, nestedSty, m) ] - | _ -> [] -#endif - -/// Lookup a type name in an entity. -let LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo: TypeNameResolutionStaticArgsInfo, modref: ModuleOrNamespaceRef) = - let mtyp = modref.ModuleOrNamespaceType - let tcrefs = - match staticResInfo with - | TypeNameResolutionStaticArgsInfo.Indefinite -> - LookupTypeNameInEntityNoArity m nm mtyp - |> List.map modref.NestedTyconRef - | TypeNameResolutionStaticArgsInfo.Definite _ -> - match LookupTypeNameInEntityHaveArity nm staticResInfo mtyp with - | Some tycon -> [modref.NestedTyconRef tycon] - | None -> [] -#if !NO_EXTENSIONTYPING - let tcrefs = - match tcrefs with - | [] -> ResolveProvidedTypeNameInEntity (amap, m, nm, modref) - | _ -> tcrefs -#else - amap |> ignore -#endif - let tcrefs = tcrefs |> List.filter (IsEntityAccessible amap m ad) - tcrefs - - -/// Make a type that refers to a nested type. -/// -/// Handle the .NET/C# business where nested generic types implicitly accumulate the type parameters -/// from their enclosing types. -let MakeNestedType (ncenv: NameResolver) (tinst: TType list) m (tcrefNested: TyconRef) = - let tps = List.skip tinst.Length (tcrefNested.Typars m) - let tinstNested = ncenv.InstantiationGenerator m tps - mkAppTy tcrefNested (tinst @ tinstNested) - -/// Get all the accessible nested types of an existing type. -let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, checkForGenerated, m) ty = - let g = ncenv.g - ncenv.InfoReader.GetPrimaryTypeHierarchy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> - match ty with - | AppTy g (tcref, tinst) -> - let tycon = tcref.Deref - let mty = tycon.ModuleOrNamespaceType - // No dotting through type generators to get to a nested type! -#if !NO_EXTENSIONTYPING - if checkForGenerated then - CheckForDirectReferenceToGeneratedType (tcref, PermitDirectReferenceToGeneratedType.No, m) -#else - checkForGenerated |> ignore -#endif - - match optFilter with - | Some nm -> - let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, m, ad, nm, staticResInfo, tcref) - tcrefs |> List.map (MakeNestedType ncenv tinst m) - | None -> -#if !NO_EXTENSIONTYPING - match tycon.TypeReprInfo with - | TProvidedTypeExtensionPoint info -> - [ for nestedType in info.ProvidedType.PApplyArray((fun sty -> sty.GetNestedTypes()), "GetNestedTypes", m) do - let nestedTypeName = nestedType.PUntaint((fun t -> t.Name), m) - for nestedTcref in LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, m, ad, nestedTypeName, staticResInfo, tcref) do - yield MakeNestedType ncenv tinst m nestedTcref ] - - | _ -> -#endif - mty.TypesByAccessNames.Values - |> List.choose (fun entity -> - let ty = tcref.NestedTyconRef entity |> MakeNestedType ncenv tinst m - if IsTypeAccessible g ncenv.amap m ad ty then Some ty else None) - | _ -> []) - //------------------------------------------------------------------------- // Report environments to visual studio. We stuff intermediary results // into a global variable. A little unpleasant. diff --git a/tests/fsharp/Compiler/Language/OpenStaticClasses.fs b/tests/fsharp/Compiler/Language/OpenStaticClasses.fs index deff83a5c42..bb257bc6c41 100644 --- a/tests/fsharp/Compiler/Language/OpenStaticClasses.fs +++ b/tests/fsharp/Compiler/Language/OpenStaticClasses.fs @@ -5,6 +5,7 @@ namespace FSharp.Compiler.UnitTests open FSharp.Compiler.SourceCodeServices open NUnit.Framework open FSharp.Test.Utilities +open FSharp.Test.Utilities.Utilities (* @@ -184,6 +185,108 @@ module OpenAFieldFromMath = let pi = PI""") [||] + [] + let ``Open type and use nested types as unqualified`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public void A() + { + } + } + + public class NestedTest + { + public void B() + { + } + } + } +} + """ + + let fsharpSource = + """ +namespace FSharpTest + +open System +open CSharpTest.Test + +module Test = + let x = NestedTest() + let y = NestedTest() + let a = x.A() + let b = y.B() + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) + + CompilerAssert.Compile(fsCmpl) + + [] + let ``Open generic type and use nested types as unqualified`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public T A() + { + return default(T); + } + } + + public class NestedTest + { + public (T, U) B() + { + return (default(T), default(U)); + } + } + } +} + """ + + let fsharpSource = + """ +namespace FSharpTest + +open System +open CSharpTest.Test + +module Test = + let x = NestedTest() + let y = NestedTest() + let a = x.A() + let b = y.B() + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) + + CompilerAssert.Compile(fsCmpl) + // TODO - wait for Will's integration of testing changes that makes this easlier // [] // let ``OpenStaticClassesTests - InternalsVisibleWhenHavingAnIVT - langversion:preview``() = ... From eabfc6abfeeaa55c841b60fff59540b0e33accea Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 22 Jun 2020 14:53:24 -0700 Subject: [PATCH 02/89] Renaming OpenStaticClasses to OpenTypeDeclaration --- src/fsharp/ConstraintSolver.fs | 4 +-- src/fsharp/ErrorLogger.fs | 10 +++++-- src/fsharp/FSComp.txt | 2 +- src/fsharp/InfoReader.fs | 10 +++++-- src/fsharp/LanguageFeatures.fs | 6 ++--- src/fsharp/LanguageFeatures.fsi | 2 +- src/fsharp/MethodCalls.fs | 4 +-- src/fsharp/MethodOverrides.fs | 2 +- src/fsharp/NameResolution.fs | 48 +++++++++++---------------------- src/fsharp/NameResolution.fsi | 4 +-- src/fsharp/TypeChecker.fs | 40 ++++++++++++++++----------- src/fsharp/TypedTreeOps.fs | 15 ----------- src/fsharp/TypedTreeOps.fsi | 2 -- 13 files changed, 68 insertions(+), 81 deletions(-) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 0469946c180..8062201e67f 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -2799,8 +2799,8 @@ and ResolveOverloading // Static IL interfaces methods are not supported in lower F# versions. if calledMeth.Method.IsILMethod && not calledMeth.Method.IsInstance && isInterfaceTy g calledMeth.Method.ApparentEnclosingType then - tryLanguageFeatureRuntimeErrorRecover csenv.InfoReader LanguageFeature.DefaultInterfaceMemberConsumption m - tryLanguageFeatureErrorRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeErrorRecover csenv.InfoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureErrorRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m calledMethOpt, trackErrors { diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index 3e345ea4abf..4b80d9b4fb0 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -683,9 +683,15 @@ let private tryLanguageFeatureErrorAux (langVersion: LanguageVersion) (langFeatu let currentVersionStr = langVersion.SpecifiedVersionString let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature error (Error(FSComp.SR.chkFeatureNotLanguageSupported(featureStr, currentVersionStr, suggestedVersionStr), m)) + false + else + true -let internal tryLanguageFeatureError langVersion langFeature m = - tryLanguageFeatureErrorAux langVersion langFeature m error +let internal checkLanguageFeatureError langVersion langFeature m = + tryLanguageFeatureErrorAux langVersion langFeature m error |> ignore + +let internal checkLanguageFeatureErrorRecover langVersion langFeature m = + tryLanguageFeatureErrorAux langVersion langFeature m errorR |> ignore let internal tryLanguageFeatureErrorRecover langVersion langFeature m = tryLanguageFeatureErrorAux langVersion langFeature m errorR \ No newline at end of file diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 6dcf26f7c22..4bdf3627857 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1504,7 +1504,7 @@ featureWildCardInForLoop,"wild card in for loop" featureRelaxWhitespace,"whitespace relexation" featureNameOf,"nameof" featureImplicitYield,"implicit yield" -featureOpenStaticClasses,"open static classes" +featureOpenTypeDeclaration,"open type declaration" featureDotlessFloat32Literal,"dotless float32 literal" featurePackageManagement,"package management" featureFromEndSlicing,"from-end slicing" diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index d7256a1a2fd..419f357ed95 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -571,9 +571,15 @@ let private tryLanguageFeatureRuntimeErrorAux (infoReader: InfoReader) langFeatu if not (infoReader.IsLanguageFeatureRuntimeSupported langFeature) then let featureStr = infoReader.g.langVersion.GetFeatureString langFeature error (Error(FSComp.SR.chkFeatureNotRuntimeSupported featureStr, m)) + false + else + true -let tryLanguageFeatureRuntimeError infoReader langFeature m = - tryLanguageFeatureRuntimeErrorAux infoReader langFeature m error +let checkLanguageFeatureRuntimeError infoReader langFeature m = + tryLanguageFeatureRuntimeErrorAux infoReader langFeature m error |> ignore + +let checkLanguageFeatureRuntimeErrorRecover infoReader langFeature m = + tryLanguageFeatureRuntimeErrorAux infoReader langFeature m errorR |> ignore let tryLanguageFeatureRuntimeErrorRecover infoReader langFeature m = tryLanguageFeatureRuntimeErrorAux infoReader langFeature m errorR diff --git a/src/fsharp/LanguageFeatures.fs b/src/fsharp/LanguageFeatures.fs index 83172b8605b..3d46c186916 100644 --- a/src/fsharp/LanguageFeatures.fs +++ b/src/fsharp/LanguageFeatures.fs @@ -23,7 +23,7 @@ type LanguageFeature = | RelaxWhitespace | NameOf | ImplicitYield - | OpenStaticClasses + | OpenTypeDeclaration | DotlessFloat32Literal | PackageManagement | FromEndSlicing @@ -63,7 +63,7 @@ type LanguageVersion (specifiedVersionAsString) = // F# preview LanguageFeature.NameOf, previewVersion - LanguageFeature.OpenStaticClasses, previewVersion + LanguageFeature.OpenTypeDeclaration, previewVersion LanguageFeature.PackageManagement, previewVersion LanguageFeature.AndBang, previewVersion LanguageFeature.NullableOptionalInterop, previewVersion @@ -129,7 +129,7 @@ type LanguageVersion (specifiedVersionAsString) = | LanguageFeature.RelaxWhitespace -> FSComp.SR.featureRelaxWhitespace() | LanguageFeature.NameOf -> FSComp.SR.featureNameOf() | LanguageFeature.ImplicitYield -> FSComp.SR.featureImplicitYield() - | LanguageFeature.OpenStaticClasses -> FSComp.SR.featureOpenStaticClasses() + | LanguageFeature.OpenTypeDeclaration -> FSComp.SR.featureOpenTypeDeclaration() | LanguageFeature.DotlessFloat32Literal -> FSComp.SR.featureDotlessFloat32Literal() | LanguageFeature.PackageManagement -> FSComp.SR.featurePackageManagement() | LanguageFeature.FromEndSlicing -> FSComp.SR.featureFromEndSlicing() diff --git a/src/fsharp/LanguageFeatures.fsi b/src/fsharp/LanguageFeatures.fsi index 5eb13e885a9..3a4258c9d14 100644 --- a/src/fsharp/LanguageFeatures.fsi +++ b/src/fsharp/LanguageFeatures.fsi @@ -11,7 +11,7 @@ type LanguageFeature = | RelaxWhitespace | NameOf | ImplicitYield - | OpenStaticClasses + | OpenTypeDeclaration | DotlessFloat32Literal | PackageManagement | FromEndSlicing diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index df06f0064ab..46b74dd95ef 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -1742,8 +1742,8 @@ let ILFieldStaticChecks g amap infoReader ad m (finfo : ILFieldInfo) = // Static IL interfaces fields are not supported in lower F# versions. if isInterfaceTy g finfo.ApparentEnclosingType then - tryLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m - tryLanguageFeatureErrorRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureErrorRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m CheckILFieldAttributes g finfo m diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 0826749fd65..066451f6eb8 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -311,7 +311,7 @@ module DispatchSlotChecking = // Always try to raise a target runtime error if we have a DIM. if reqdSlot.HasDefaultInterfaceImplementation then - tryLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m let maybeResolvedSlot = NameMultiMap.find dispatchSlot.LogicalName overridesKeyed diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index d858914c15c..1712d6d078a 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -800,7 +800,7 @@ let GetStaticPropertyItems infoReader nenv ad m ty = yield KeyValuePair(propName , Item.Property(propName,[propInfo])) } -let GetStaticFieldItems (infoReader: InfoReader) ad m ty = +let GetStaticILFieldItems (infoReader: InfoReader) ad m ty = let fields = infoReader.GetILFieldInfosOfType(None, ad, m, ty) |> List.groupBy (fun f -> f.FieldName) @@ -1059,9 +1059,9 @@ let MakeNestedTypeNoInstantiation (tinst: TType list) m (tcrefNested: TyconRef) let tinstNested = tps |> List.map mkTyparTy mkAppTy tcrefNested (tinst @ tinstNested) -let GetNestedTypeItemsOfType infoReader amap ad m ty = +let GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty = let nestedTcrefGroups = - GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) ty + GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty |> List.groupBy (fun (_, m) -> DemangleGenericTypeName m.LogicalName) seq { @@ -1073,17 +1073,17 @@ let GetNestedTypeItemsOfType infoReader amap ad m ty = } let AddStaticContentOfTyconRefToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (tcref:TyconRef) = - // If OpenStaticClasses is not enabled then don't do this - if amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses then + // If OpenTypeDeclaration is not enabled then don't do this + if amap.g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration then let ty = generalizedTyconRef tcref let infoReader = InfoReader(g,amap) let items = [| - yield! GetNestedTypeItemsOfType infoReader amap ad m ty + yield! GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty yield! GetStaticMethodItems infoReader nenv ad m ty yield! GetStaticPropertyItems infoReader nenv ad m ty - yield! GetStaticFieldItems infoReader ad m ty + yield! GetStaticILFieldItems infoReader ad m ty yield! GetStaticEventItems infoReader ad m ty |] @@ -1164,7 +1164,7 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) eUnindexedExtensionMembers = eUnindexedExtensionMembers } let nenv = - if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && isStaticClass g tcref then + if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true then AddStaticContentOfTyconRefToNameEnv g amap ad m nenv tcref else nenv @@ -2110,16 +2110,13 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities //------------------------------------------------------------------------- /// Perform name resolution for an identifier which must resolve to be a namespace or module. -let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m allowStaticClasses first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl = - - // If the selected language version doesn't support open static classes then turn them off. - let allowStaticClasses = allowStaticClasses && amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses +let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl = if first && id.idText = MangledGlobalName then match rest with | [] -> error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) | id2 :: rest2 -> - ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink atMostOne amap m allowStaticClasses false FullyQualified nenv ad id2 rest2 isOpenDecl + ResolveLongIdentAsModuleOrNamespace sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl else let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified let namespaceNotFound = lazy( @@ -2159,17 +2156,11 @@ let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: Resul match moduleOrNamespaces.TryGetValue id.idText with | true, modrefs -> modrefs | _ -> [] - - let tcrefs = - if allowStaticClasses then - LookupTypeNameInEnvNoArity fullyQualified id.idText nenv |> List.filter (isStaticClass amap.g) - else [] - - modrefs @ tcrefs + modrefs if not erefs.IsEmpty then /// Look through the sub-namespaces and/or modules - let rec look depth allowStaticClasses (modref: ModuleOrNamespaceRef) (lid: Ident list) = + let rec look depth (modref: ModuleOrNamespaceRef) (lid: Ident list) = let mty = modref.ModuleOrNamespaceType match lid with | [] -> @@ -2181,12 +2172,7 @@ let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: Resul match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with | true, res -> [res] | _ -> [] - let tspecs = - if allowStaticClasses then - LookupTypeNameInEntityNoArity id.idRange id.idText mty - |> List.filter (modref.NestedTyconRef >> isStaticClass amap.g) - else [] - mspecs @ tspecs + mspecs if not especs.IsEmpty then especs @@ -2194,8 +2180,7 @@ let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: Resul let subref = modref.NestedTyconRef espec if IsEntityAccessible amap m ad subref then notifyNameResolution subref id.idRange - let allowStaticClasses = allowStaticClasses && (subref.IsModuleOrNamespace || isStaticClass amap.g subref) - look (depth+1) allowStaticClasses subref rest + look (depth+1) subref rest else moduleNotFound modref mty id depth) |> List.reduce AddResults @@ -2206,8 +2191,7 @@ let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: Resul |> List.map (fun eref -> if IsEntityAccessible amap m ad eref then notifyNameResolution eref id.idRange - let allowStaticClasses = allowStaticClasses && (eref.IsModuleOrNamespace || isStaticClass amap.g eref) - look 1 allowStaticClasses eref rest + look 1 eref rest else raze (namespaceNotFound.Force())) |> List.reduce AddResults @@ -2216,7 +2200,7 @@ let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: Resul // Note - 'rest' is annotated due to a bug currently in Unity (see: https://github.com/dotnet/fsharp/pull/7427) let ResolveLongIndentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f = - match ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink ResultCollectionSettings.AllResults amap m false true fullyQualified nenv ad id [] isOpenDecl with + match ResolveLongIdentAsModuleOrNamespace sink ResultCollectionSettings.AllResults amap m true fullyQualified nenv ad id [] isOpenDecl with | Result modrefs -> match rest with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), id.idRange)) diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 685871c056a..ace34f71e59 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -523,8 +523,8 @@ type PermitDirectReferenceToGeneratedType = | Yes | No -/// Resolve a long identifier to a namespace, module or static class. -val internal ResolveLongIndentAsModuleOrNamespaceOrStaticClass : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> allowStaticClasses: bool -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > +/// Resolve a long identifier to a namespace, module. +val internal ResolveLongIdentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > /// Resolve a long identifier to an object constructor. val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index d3f67c28ae7..2f6ccf037f1 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -648,7 +648,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = match enclosingNamespacePathToOpen with | id :: rest -> let ad = env.eAccessRights - match ResolveLongIndentAsModuleOrNamespaceOrStaticClass tcSink ResultCollectionSettings.AllResults amap scopem true true OpenQualified env.eNameResEnv ad id rest true with + match ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap scopem true OpenQualified env.eNameResEnv ad id rest true with | Result modrefs -> let modrefs = List.map p23 modrefs let openDecl = OpenDeclaration.Create (enclosingNamespacePathToOpen, modrefs, scopem, true) @@ -7135,7 +7135,7 @@ and TcConstExpr cenv overallTy env m tpenv c = let expr = let modName = "NumericLiteral" + suffix let ad = env.eAccessRights - match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AtMostOneResult cenv.amap m true true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with + match ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AtMostOneResult cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with | Result [] | Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule modName, m)) | Result ((_, mref, _) :: _) -> @@ -9279,7 +9279,7 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = let resolvedToModuleOrNamespaceName = if delayed.IsEmpty then let id,rest = List.headAndTail longId - match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest true with + match ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest true 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 | _ -> @@ -12935,19 +12935,27 @@ let TcTyconMemberSpecs cenv env containerInfo declKind tpenv augSpfn = // Bind 'open' declarations //------------------------------------------------------------------------- -let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) = +let TcOpenLidAndPermitAutoResolve tcSink (g: TcGlobals) ncenv env amap (longId : Ident list) isOpenType = let ad = env.eAccessRights match longId with | [] -> [] | id :: rest -> let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges - match ResolveLongIndentAsModuleOrNamespaceOrStaticClass tcSink ResultCollectionSettings.AllResults amap m true true OpenQualified env.eNameResEnv ad id rest true with + let resOrEx = + if isOpenType then + if tryLanguageFeatureErrorRecover g.langVersion LanguageFeature.OpenTypeDeclaration m then + ResolveTypeLongIdent tcSink ncenv ItemOccurence.Open OpenQualified env.eNameResEnv ad longId (TypeNameResolutionStaticArgsInfo.FromTyArgs(0)) PermitDirectReferenceToGeneratedType.No + else + [] + else + ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.eNameResEnv ad id rest true + match resOrEx with | Result res -> res | Exception err -> errorR(err); [] -let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = - match TcOpenLidAndPermitAutoResolve tcSink env amap longId with +let TcOpenDecl tcSink (g: TcGlobals) ncenv amap m scopem env (longId: Ident list) = + match TcOpenLidAndPermitAutoResolve tcSink ncenv env amap longId with | [] -> env | modrefs -> @@ -14234,8 +14242,8 @@ module MutRecBindingChecking = #if OPEN_IN_TYPE_DECLARATIONS | Phase2AOpen(mp, m) -> - let envInstance = TcOpenDecl cenv.tcSink g cenv.amap m scopem envInstance mp - let envStatic = TcOpenDecl cenv.tcSink g cenv.amap m scopem envStatic mp + let envInstance = TcOpenDecl cenv.tcSink g cenv.nameResolver cenv.amap m scopem envInstance mp + let envStatic = TcOpenDecl cenv.tcSink g cenv.nameResolver cenv.amap m scopem envStatic mp let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BOpen, innerState #endif @@ -14480,7 +14488,7 @@ module MutRecBindingChecking = let resolved = match p with | [] -> Result [] - | id :: rest -> ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest false + | id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest false let mvvs = ForceRaise resolved if isNil mvvs then env else let modrefs = mvvs |> List.map p23 @@ -14542,7 +14550,7 @@ module MutRecBindingChecking = // Add the modules being defined let envForDecls = (envForDecls, mspecs) ||> List.fold ((if report then AddLocalSubModuleAndReport cenv.tcSink scopem else AddLocalSubModule) cenv.g cenv.amap m) // Process the 'open' declarations - let envForDecls = (envForDecls, opens) ||> List.fold (fun env (mp, m, moduleRange) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m moduleRange env mp) + let envForDecls = (envForDecls, opens) ||> List.fold (fun env (mp, m, moduleRange) -> TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m moduleRange env mp) // Add the type definitions being defined let envForDecls = (if report then AddLocalTyconsAndReport cenv.tcSink scopem else AddLocalTycons) cenv.g cenv.amap m tycons envForDecls // Add the exception definitions being defined @@ -17301,7 +17309,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS | SynModuleSigDecl.Open (mp, m) -> let scopem = unionRanges m.EndRange endm - let env = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp + let env = TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m scopem env mp return env | SynModuleSigDecl.Val (vspec, m) -> @@ -17349,7 +17357,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS let resolved = match p with | [] -> Result [] - | id :: rest -> ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest false + | id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest false let mvvs = ForceRaise resolved let scopem = unionRanges m endm let unfilteredModrefs = mvvs |> List.map p23 @@ -17419,7 +17427,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment. let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m.EndRange m.EndRange env [p] | None -> env // Publish the combined module type @@ -17595,7 +17603,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem | SynModuleDecl.Open (LongIdentWithDots(mp, _), m) -> let scopem = unionRanges m.EndRange scopem - let env = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp + let env = TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m scopem env mp return ((fun e -> e), []), env, env | SynModuleDecl.Let (letrec, binds, m) -> @@ -17728,7 +17736,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m.EndRange m.EndRange env [p] | None -> env // Publish the combined module type diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 71792597a69..791eaad2a3b 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -9163,21 +9163,6 @@ let (|ValApp|_|) g vref expr = | Expr.App (Expr.Val (vref2, _, _), _f0ty, tyargs, args, m) when valRefEq g vref vref2 -> Some (tyargs, args, m) | _ -> None -let isStaticClass (g:TcGlobals) (x: EntityRef) = - not x.IsModuleOrNamespace && - x.TyparsNoRange.IsEmpty && - ((x.IsILTycon && - x.ILTyconRawMetadata.IsSealed && - x.ILTyconRawMetadata.IsAbstract) -#if !NO_EXTENSIONTYPING - || (x.IsProvided && - match x.TypeReprInfo with - | TProvidedTypeExtensionPoint info -> info.IsSealed && info.IsAbstract - | _ -> false) -#endif - || (not x.IsILTycon && not x.IsProvided && HasFSharpAttribute g g.attrib_AbstractClassAttribute x.Attribs)) && - not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute x.Attribs) - /// Combine a list of ModuleOrNamespaceType's making up the description of a CCU. checking there are now /// duplicate modules etc. let CombineCcuContentFragments m l = diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 7d10918c91f..27394627a98 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2368,8 +2368,6 @@ val EmptyTraitWitnessInfoHashMap: TcGlobals -> TraitWitnessInfoHashMap<'T> /// Match expressions that are an application of a particular F# function value val (|ValApp|_|) : TcGlobals -> ValRef -> Expr -> (TypeInst * Exprs * range) option -val isStaticClass: g: TcGlobals -> tcref: TyconRef -> bool - val CombineCcuContentFragments: range -> ModuleOrNamespaceType list -> ModuleOrNamespaceType /// Recognise a while expression From 69f13282878b3c6fb1722332d212a8162a0edde7 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 22 Jun 2020 18:28:08 -0700 Subject: [PATCH 03/89] Added 'open type' declaration --- src/fsharp/CompileOps.fs | 8 +- src/fsharp/MethodOverrides.fs | 2 +- src/fsharp/NameResolution.fs | 119 +++++++++++------- src/fsharp/NameResolution.fsi | 19 +-- src/fsharp/SyntaxTree.fs | 3 + src/fsharp/TypeChecker.fs | 52 ++++---- src/fsharp/TypeChecker.fsi | 2 +- src/fsharp/pars.fsy | 15 ++- src/fsharp/service/FSharpCheckerResults.fs | 6 +- src/fsharp/service/ServiceAssemblyContent.fs | 4 +- src/fsharp/service/ServiceParseTreeWalk.fs | 4 +- src/fsharp/service/ServiceStructure.fs | 6 +- src/fsharp/service/ServiceUntypedParse.fs | 6 +- src/fsharp/service/ServiceUntypedParse.fsi | 2 +- src/fsharp/xlf/FSComp.txt.cs.xlf | 6 +- src/fsharp/xlf/FSComp.txt.de.xlf | 6 +- src/fsharp/xlf/FSComp.txt.es.xlf | 6 +- src/fsharp/xlf/FSComp.txt.fr.xlf | 6 +- src/fsharp/xlf/FSComp.txt.it.xlf | 6 +- src/fsharp/xlf/FSComp.txt.ja.xlf | 6 +- src/fsharp/xlf/FSComp.txt.ko.xlf | 6 +- src/fsharp/xlf/FSComp.txt.pl.xlf | 6 +- src/fsharp/xlf/FSComp.txt.pt-BR.xlf | 6 +- src/fsharp/xlf/FSComp.txt.ru.xlf | 6 +- src/fsharp/xlf/FSComp.txt.tr.xlf | 6 +- src/fsharp/xlf/FSComp.txt.zh-Hans.xlf | 6 +- src/fsharp/xlf/FSComp.txt.zh-Hant.xlf | 6 +- ...Classes.fs => OpenTypeDeclarationTests.fs} | 58 ++++----- tests/fsharp/FSharpSuite.Tests.fsproj | 2 +- 29 files changed, 216 insertions(+), 170 deletions(-) rename tests/fsharp/Compiler/Language/{OpenStaticClasses.fs => OpenTypeDeclarationTests.fs} (85%) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index f44e3f1aed0..4cbc74d39eb 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -5580,7 +5580,7 @@ let GetInitialTcEnv (thisAssemblyName: string, initm: range, tcConfig: TcConfig, let tcEnv = CreateInitialTcEnv(tcGlobals, amap, initm, thisAssemblyName, ccus) if tcConfig.checkOverflow then - try TcOpenDecl TcResultsSink.NoSink tcGlobals amap initm initm tcEnv (pathToSynLid initm (splitNamespace FSharpLib.CoreOperatorsCheckedName)) + try TcOpenDecl TcResultsSink.NoSink tcGlobals amap initm initm tcEnv (pathToSynLid initm (splitNamespace FSharpLib.CoreOperatorsCheckedName)) false with e -> errorRecovery e initm; tcEnv else tcEnv @@ -5737,7 +5737,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: | None -> tcEnv | Some prefixPath -> let m = qualNameOfFile.Range - TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath + TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath false let tcState = { tcState with @@ -5785,13 +5785,13 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: // Open the prefixPath for fsi.exe (tcImplEnv) let tcImplEnv = match prefixPathOpt with - | Some prefixPath -> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath + | Some prefixPath -> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath false | _ -> tcImplEnv // Open the prefixPath for fsi.exe (tcSigEnv) let tcSigEnv = match prefixPathOpt with - | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath + | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath false | _ -> tcSigEnv let ccuSig = CombineCcuContentFragments m [implFileSigType; tcState.tcsCcuSig ] diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 066451f6eb8..d5105e649dc 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -329,7 +329,7 @@ module DispatchSlotChecking = then // Always try to raise a language version error if we have a DIM that is not explicitly implemented. if reqdSlot.HasDefaultInterfaceImplementation then - tryLanguageFeatureErrorRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureErrorRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m if reqdSlot.PossiblyNoMostSpecificImplementation then errorR(Error(FSComp.SR.typrelInterfaceMemberNoMostSpecificImplementation(NicePrint.stringOfMethInfo amap m denv dispatchSlot), m)) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 1712d6d078a..c4f98b8e0f3 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1073,23 +1073,19 @@ let GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty = } let AddStaticContentOfTyconRefToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (tcref:TyconRef) = - // If OpenTypeDeclaration is not enabled then don't do this - if amap.g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration then - let ty = generalizedTyconRef tcref - let infoReader = InfoReader(g,amap) - - let items = - [| - yield! GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty - yield! GetStaticMethodItems infoReader nenv ad m ty - yield! GetStaticPropertyItems infoReader nenv ad m ty - yield! GetStaticILFieldItems infoReader ad m ty - yield! GetStaticEventItems infoReader ad m ty - |] - - { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } - else - nenv + let ty = generalizedTyconRef tcref + let infoReader = InfoReader(g,amap) + + let items = + [| + yield! GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty + yield! GetStaticMethodItems infoReader nenv ad m ty + yield! GetStaticPropertyItems infoReader nenv ad m ty + yield! GetStaticILFieldItems infoReader ad m ty + yield! GetStaticEventItems infoReader ad m ty + |] + + { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } /// Add any implied contents of a type definition to the environment. let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = @@ -1164,7 +1160,8 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) eUnindexedExtensionMembers = eUnindexedExtensionMembers } let nenv = - if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true then + if amap.g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && + TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true then AddStaticContentOfTyconRefToNameEnv g amap ad m nenv tcref else nenv @@ -2106,17 +2103,17 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities //------------------------------------------------------------------------- -// Consume ids that refer to a namespace +// Consume ids that refer to a namespace, module, or type //------------------------------------------------------------------------- -/// Perform name resolution for an identifier which must resolve to be a namespace or module. -let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl = +/// Perform name resolution for an identifier which must resolve to be a module or namespace. +let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl isType = if first && id.idText = MangledGlobalName then match rest with | [] -> error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) | id2 :: rest2 -> - ResolveLongIdentAsModuleOrNamespace sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl + ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl isType else let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified let namespaceNotFound = lazy( @@ -2152,11 +2149,23 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occurence, ad) let erefs = - let modrefs = - match moduleOrNamespaces.TryGetValue id.idText with - | true, modrefs -> modrefs - | _ -> [] - modrefs + let modrefs = + // If we are not resolving a type, then always resolve a module or namespace. + // If we are resolving a type, but the rest is not empty, we might need to resolve a module or namespace. + if not isType || (isType && not rest.IsEmpty) then + match moduleOrNamespaces.TryGetValue id.idText with + | true, modrefs -> modrefs + | _ -> [] + else + [] + + let tcrefs = + if isType then + LookupTypeNameInEnvNoArity fullyQualified id.idText nenv + else + [] + + modrefs @ tcrefs if not erefs.IsEmpty then /// Look through the sub-namespaces and/or modules @@ -2167,12 +2176,22 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet success [ (depth, modref, mty) ] | id :: rest -> - let especs = - let mspecs = - match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with - | true, res -> [res] - | _ -> [] - mspecs + let especs = + let modrefs = + if not isType || (isType && not rest.IsEmpty) then + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, res -> [res] + | _ -> [] + else + [] + + let tcrefs = + if isType then + LookupTypeNameInEntityNoArity id.idRange id.idText mty + else + [] + + modrefs @ tcrefs if not especs.IsEmpty then especs @@ -2198,8 +2217,12 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet else raze (namespaceNotFound.Force()) +/// Perform name resolution for an identifier which must resolve to be a module or namespace. +let ResolveLongIdentAsModuleOrNamespace sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl = + ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl false + // Note - 'rest' is annotated due to a bug currently in Unity (see: https://github.com/dotnet/fsharp/pull/7427) -let ResolveLongIndentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f = +let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f = match ResolveLongIdentAsModuleOrNamespace sink ResultCollectionSettings.AllResults amap m true fullyQualified nenv ad id [] isOpenDecl with | Result modrefs -> match rest with @@ -2211,6 +2234,14 @@ let ResolveLongIndentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualifie f resInfo (depth+1) id.idRange modref mty id2 rest2) | Exception err -> Exception err +/// Perform name resolution for an identifier which must resolve to be a type to be used as a module or namespace. +let ResolveTypeLongIdentAsModuleOrNamespace sink atMostOne (amap: Import.ImportMap) m first fullyQualified nenv ad id rest isOpenDecl = + let g = amap.g + if tryLanguageFeatureErrorRecover g.langVersion LanguageFeature.OpenTypeDeclaration m then + ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl true + else + NoResultsOrUsefulErrors + //------------------------------------------------------------------------- // Bind name used in "new Foo.Bar(...)" constructs //------------------------------------------------------------------------- @@ -2739,7 +2770,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 () = - ResolveLongIndentAsModuleOrNamespaceThen 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 (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad) // REVIEW: somewhat surprisingly, this shows up on performance traces, with tcrefs non-nil. @@ -2924,7 +2955,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa // Long identifiers in patterns else let moduleSearch ad () = - ResolveLongIndentAsModuleOrNamespaceThen 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 (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad) let tyconSearch ad = @@ -3138,12 +3169,12 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full NoResultsOrUsefulErrors let modulSearch = - ResolveLongIndentAsModuleOrNamespaceThen 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 (ResolveTypeLongIdentInModuleOrNamespace sink nenv ncenv typeNameResInfo ad genOk) |?> List.concat let modulSearchFailed() = - ResolveLongIndentAsModuleOrNamespaceThen 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 (ResolveTypeLongIdentInModuleOrNamespace sink nenv ncenv typeNameResInfo.DropStaticArgsInfo AccessibleFromSomeFSharpCode genOk) |?> List.concat @@ -3345,7 +3376,7 @@ let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFi match lid with | [] -> NoResultsOrUsefulErrors | id2 :: rest2 -> - ResolveLongIndentAsModuleOrNamespaceThen 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 (ResolveFieldInModuleOrNamespace ncenv nenv ad) let resInfo, item, rest = @@ -3639,7 +3670,7 @@ let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f plid (m | true, mty -> PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest (modref.NestedTyconRef mty) | _ -> [] -let PartialResolveLongIndentAsModuleOrNamespaceThen (nenv: NameResolutionEnv) plid f = +let PartialResolveLongIdentAsModuleOrNamespaceThen (nenv: NameResolutionEnv) plid f = match plid with | id :: rest -> match nenv.eModulesAndNamespaces.TryGetValue id with @@ -4188,7 +4219,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE // Look in the namespaces 'id' let namespaces = - PartialResolveLongIndentAsModuleOrNamespaceThen nenv [id] (fun modref -> + PartialResolveLongIdentAsModuleOrNamespaceThen nenv [id] (fun modref -> let allowObsolete = rest <> [] && allowObsolete if EntityRefContainsSomethingAccessible ncenv m ad modref then ResolvePartialLongIdentInModuleOrNamespace ncenv nenv isApplicableMeth m ad modref rest allowObsolete @@ -4349,7 +4380,7 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: | id :: rest -> // Get results let modsOrNs = - PartialResolveLongIndentAsModuleOrNamespaceThen nenv [id] (fun modref -> + PartialResolveLongIdentAsModuleOrNamespaceThen nenv [id] (fun modref -> let allowObsolete = rest <> [] && allowObsolete if EntityRefContainsSomethingAccessible ncenv m ad modref then ResolvePartialLongIdentInModuleOrNamespaceForRecordFields ncenv nenv m ad modref rest allowObsolete @@ -4707,7 +4738,7 @@ let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f pli PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest (modref.NestedTyconRef mty) | _ -> Seq.empty -let PartialResolveLongIndentAsModuleOrNamespaceThenLazy (nenv: NameResolutionEnv) plid f = +let PartialResolveLongIdentAsModuleOrNamespaceThenLazy (nenv: NameResolutionEnv) plid f = seq { match plid with | id :: rest -> @@ -4782,7 +4813,7 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a // Look in the namespaces 'id' yield! - PartialResolveLongIndentAsModuleOrNamespaceThenLazy nenv [id] (fun modref -> + PartialResolveLongIdentAsModuleOrNamespaceThenLazy nenv [id] (fun modref -> if EntityRefContainsSomethingAccessible ncenv m ad modref then ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad modref rest item else Seq.empty) diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index ace34f71e59..067bdbcea43 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -524,28 +524,31 @@ type PermitDirectReferenceToGeneratedType = | No /// Resolve a long identifier to a namespace, module. -val internal ResolveLongIdentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > +val internal ResolveLongIdentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > + +/// Resolve a long identifier to a type to be used like a namespace, module. +val internal ResolveTypeLongIdentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > /// Resolve a long identifier to an object constructor. -val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException +val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException /// Resolve a long identifier using type-qualified name resolution. -val internal ResolveLongIdentInType : TcResultsSink -> NameResolver -> NameResolutionEnv -> LookupKind -> range -> AccessorDomain -> Ident -> FindMemberFlag -> TypeNameResolutionInfo -> TType -> Item * Ident list +val internal ResolveLongIdentInType : TcResultsSink -> NameResolver -> NameResolutionEnv -> LookupKind -> range -> AccessorDomain -> Ident -> FindMemberFlag -> TypeNameResolutionInfo -> TType -> Item * Ident list /// Resolve a long identifier when used in a pattern. -val internal ResolvePatternLongIdent : TcResultsSink -> NameResolver -> WarnOnUpperFlag -> bool -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item +val internal ResolvePatternLongIdent : TcResultsSink -> NameResolver -> WarnOnUpperFlag -> bool -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item /// Resolve a long identifier representing a type name -val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResolver -> NameResolutionEnv -> TypeNameResolutionInfo -> AccessorDomain -> range -> ModuleOrNamespaceRef -> Ident list -> TyconRef +val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResolver -> NameResolutionEnv -> TypeNameResolutionInfo -> AccessorDomain -> range -> ModuleOrNamespaceRef -> Ident list -> TyconRef /// Resolve a long identifier to a type definition -val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException +val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException /// Resolve a long identifier to a field -val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list +val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list /// Resolve a long identifier occurring in an expression position -val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * Ident list +val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * Ident list /// Resolve a (possibly incomplete) long identifier to a loist of possible class or record fields val internal ResolvePartialLongIdentToClassOrRecdFields : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> bool -> Item list diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs index 94fd921eaff..a3998afd123 100644 --- a/src/fsharp/SyntaxTree.fs +++ b/src/fsharp/SyntaxTree.fs @@ -1857,6 +1857,7 @@ type SynMemberDefn = /// An 'open' definition within a type | Open of longId: LongIdent * + isOpenType: bool * range: range /// A 'member' definition within a type @@ -1989,6 +1990,7 @@ type SynModuleDecl = /// An 'open' definition within a module | Open of longDotId: LongIdentWithDots * + isOpenType: bool * range: range /// An attribute definition within a module, for assembly and .NET module attributes @@ -2062,6 +2064,7 @@ type SynModuleSigDecl = /// An 'open' definition within a module or namespace in a signature file | Open of longId: LongIdent * + isOpenType: bool * range: range /// A hash directive within a module or namespace in a signature file diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 2f6ccf037f1..4b34cce3999 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -4231,7 +4231,7 @@ type ValSpecResult = ValSpecResult of ParentRef * ValMemberInfoTransient option type RecDefnBindingInfo = RecDefnBindingInfo of ContainerInfo * NewSlotsOK * DeclKind * SynBinding -type MutRecDataForOpen = MutRecDataForOpen of LongIdent * range * appliedScope: range +type MutRecDataForOpen = MutRecDataForOpen of LongIdent * isOpenType: bool * range * appliedScope: range type MutRecDataForModuleAbbrev = MutRecDataForModuleAbbrev of Ident * LongIdent * range type MutRecSigsInitialData = MutRecShape list @@ -12935,7 +12935,7 @@ let TcTyconMemberSpecs cenv env containerInfo declKind tpenv augSpfn = // Bind 'open' declarations //------------------------------------------------------------------------- -let TcOpenLidAndPermitAutoResolve tcSink (g: TcGlobals) ncenv env amap (longId : Ident list) isOpenType = +let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) isOpenType = let ad = env.eAccessRights match longId with | [] -> [] @@ -12943,10 +12943,7 @@ let TcOpenLidAndPermitAutoResolve tcSink (g: TcGlobals) ncenv env amap (longId : let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges let resOrEx = if isOpenType then - if tryLanguageFeatureErrorRecover g.langVersion LanguageFeature.OpenTypeDeclaration m then - ResolveTypeLongIdent tcSink ncenv ItemOccurence.Open OpenQualified env.eNameResEnv ad longId (TypeNameResolutionStaticArgsInfo.FromTyArgs(0)) PermitDirectReferenceToGeneratedType.No - else - [] + ResolveTypeLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.eNameResEnv ad id rest true else ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.eNameResEnv ad id rest true match resOrEx with @@ -12954,8 +12951,8 @@ let TcOpenLidAndPermitAutoResolve tcSink (g: TcGlobals) ncenv env amap (longId : | Exception err -> errorR(err); [] -let TcOpenDecl tcSink (g: TcGlobals) ncenv amap m scopem env (longId: Ident list) = - match TcOpenLidAndPermitAutoResolve tcSink ncenv env amap longId with +let TcOpenDecl tcSink g amap m scopem env longId isOpenType = + match TcOpenLidAndPermitAutoResolve tcSink env amap longId isOpenType with | [] -> env | modrefs -> @@ -13008,8 +13005,7 @@ let TcOpenDecl tcSink (g: TcGlobals) ncenv amap m scopem env (longId: Ident list let openDecl = OpenDeclaration.Create (longId, modrefs, scopem, false) let env = OpenEntities tcSink g amap scopem false env modrefs openDecl - env - + env exception ParameterlessStructCtor of range @@ -13845,7 +13841,7 @@ module MutRecBindingChecking = | Phase2AMember of PreCheckingRecursiveBinding #if OPEN_IN_TYPE_DECLARATIONS /// A dummy declaration, should we ever support 'open' in type definitions - | Phase2AOpen of LongIdent * range + | Phase2AOpen of LongIdent * isOpenType: bool * range #endif /// Indicates the super init has just been called, 'this' may now be published | Phase2AIncrClassCtorJustAfterSuperInit @@ -14027,9 +14023,9 @@ module MutRecBindingChecking = cbinds, innerState #if OPEN_IN_TYPE_DECLARATIONS - | SynMemberDefn.Open (mp, m), _ -> + | SynMemberDefn.Open (mp, isOpenType, m), _ -> let innerState = (incrClassCtorLhsOpt, env, tpenv, recBindIdx, prelimRecValuesRev, uncheckedBindsRev) - [ Phase2AOpen (mp, m) ], innerState + [ Phase2AOpen (mp, isOpenType, m) ], innerState #endif | definition -> @@ -14241,9 +14237,9 @@ module MutRecBindingChecking = #if OPEN_IN_TYPE_DECLARATIONS - | Phase2AOpen(mp, m) -> - let envInstance = TcOpenDecl cenv.tcSink g cenv.nameResolver cenv.amap m scopem envInstance mp - let envStatic = TcOpenDecl cenv.tcSink g cenv.nameResolver cenv.amap m scopem envStatic mp + | Phase2AOpen(mp, isOpenType, m) -> + let envInstance = TcOpenDecl cenv.tcSink g cenv.amap m scopem envInstance mp isOpenType + let envStatic = TcOpenDecl cenv.tcSink g cenv.amap m scopem envStatic mp isOpenType let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BOpen, innerState #endif @@ -14524,7 +14520,7 @@ module MutRecBindingChecking = let tycons = decls |> List.choose (function MutRecShape.Tycon d -> getTyconOpt d | _ -> None) let mspecs = decls |> List.choose (function MutRecShape.Module (MutRecDefnsPhase2DataForModule (_, mspec), _) -> Some mspec | _ -> None) let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) - let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (mp, m, moduleRange)) -> Some (mp, m, moduleRange) | _ -> None) + let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (mp, isOpenType, m, moduleRange)) -> Some (mp, isOpenType, m, moduleRange) | _ -> None) let lets = decls |> List.collect (function MutRecShape.Lets binds -> getVals binds | _ -> []) let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsExceptionDecl) @@ -14550,7 +14546,7 @@ module MutRecBindingChecking = // Add the modules being defined let envForDecls = (envForDecls, mspecs) ||> List.fold ((if report then AddLocalSubModuleAndReport cenv.tcSink scopem else AddLocalSubModule) cenv.g cenv.amap m) // Process the 'open' declarations - let envForDecls = (envForDecls, opens) ||> List.fold (fun env (mp, m, moduleRange) -> TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m moduleRange env mp) + let envForDecls = (envForDecls, opens) ||> List.fold (fun env (mp, isOpenType, m, moduleRange) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m moduleRange env mp isOpenType) // Add the type definitions being defined let envForDecls = (if report then AddLocalTyconsAndReport cenv.tcSink scopem else AddLocalTycons) cenv.g cenv.amap m tycons envForDecls // Add the exception definitions being defined @@ -17307,9 +17303,9 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS let env = TcDeclarations.TcMutRecSignatureDecls cenv env parent typeNames emptyUnscopedTyparEnv m scopem None mutRecDefns return env - | SynModuleSigDecl.Open (mp, m) -> + | SynModuleSigDecl.Open (mp, isOpenType, m) -> let scopem = unionRanges m.EndRange endm - let env = TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m scopem env mp + let env = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp isOpenType return env | SynModuleSigDecl.Val (vspec, m) -> @@ -17427,7 +17423,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment. let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] false | None -> env // Publish the combined module type @@ -17472,9 +17468,9 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d let decls = typeSpecs |> List.map MutRecShape.Tycon decls, (false, false) - | SynModuleSigDecl.Open (lid, m) -> + | SynModuleSigDecl.Open (lid, isOpenType, m) -> if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) - let decls = [ MutRecShape.Open (MutRecDataForOpen(lid, m, moduleRange)) ] + let decls = [ MutRecShape.Open (MutRecDataForOpen(lid, isOpenType, m, moduleRange)) ] decls, (openOk, moduleAbbrevOk) | SynModuleSigDecl.Exception (SynExceptionSig(exnRepr, members, _), _) -> @@ -17601,9 +17597,9 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem return (exprfWithEscapeCheck, []), envAfter, envAfter - | SynModuleDecl.Open (LongIdentWithDots(mp, _), m) -> + | SynModuleDecl.Open (LongIdentWithDots(mp, _), isOpenType, m) -> let scopem = unionRanges m.EndRange scopem - let env = TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m scopem env mp + let env = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp isOpenType return ((fun e -> e), []), env, env | SynModuleDecl.Let (letrec, binds, m) -> @@ -17736,7 +17732,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.nameResolver cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] false | None -> env // Publish the combined module type @@ -17803,9 +17799,9 @@ and TcModuleOrNamespaceElementsMutRec cenv parent typeNames m envInitial mutRecN let decls = [MutRecShape.Module (compInfo, mutRecDefs)] decls, (false, false, attrs) - | SynModuleDecl.Open (LongIdentWithDots(lid, _), m) -> + | SynModuleDecl.Open (LongIdentWithDots(lid, _), isOpenType, m) -> if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) - let decls = [ MutRecShape.Open (MutRecDataForOpen(lid, m, moduleRange)) ] + let decls = [ MutRecShape.Open (MutRecDataForOpen(lid, isOpenType, m, moduleRange)) ] decls, (openOk, moduleAbbrevOk, attrs) | SynModuleDecl.Exception (SynExceptionDefn(repr, members, _), _m) -> diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index 49471c97d7e..9154102585d 100644 --- a/src/fsharp/TypeChecker.fsi +++ b/src/fsharp/TypeChecker.fsi @@ -26,7 +26,7 @@ val AddCcuToTcEnv : TcGlobals * ImportMap * range * TcEnv * assemblyName: s val AddLocalRootModuleOrNamespace : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> TcEnv -> ModuleOrNamespaceType -> TcEnv val AddLocalVal : NameResolution.TcResultsSink -> scopem: range -> v: Val -> TcEnv -> TcEnv val AddLocalSubModule : TcGlobals -> ImportMap -> range -> TcEnv -> ModuleOrNamespace -> TcEnv -val TcOpenDecl : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> range -> TcEnv -> LongIdent -> TcEnv +val TcOpenDecl : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> range -> TcEnv -> LongIdent -> isOpenType: bool -> TcEnv type TopAttribs = { mainMethodAttrs : Attribs; diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 28d9e9df8d9..9a710ab3f2e 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -289,6 +289,7 @@ let rangeOfLongIdent(lid:LongIdent) = %type exconCore %type moduleDefnsOrExprPossiblyEmptyOrBlock %type openDecl +%type openTypeDecl %type path %type pathOp /* LESS GREATER parsedOk typeArgs m for each mWhole */ @@ -768,7 +769,10 @@ moduleSpfn: SynModuleSigDecl.Exception(ec, rhs parseState 3) } | OPEN path - { SynModuleSigDecl.Open ($2.Lid, unionRanges (rhs parseState 1) $2.Range) } + { SynModuleSigDecl.Open ($2.Lid, false, unionRanges (rhs parseState 1) $2.Range) } + + | OPEN typeKeyword path + { SynModuleSigDecl.Open ($3.Lid, true, unionRanges (unionRanges (rhs parseState 1) (rhs parseState 2)) $3.Range) } valSpfn: | opt_attributes opt_declVisibility VAL opt_attributes opt_inline opt_mutable opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints optLiteralValueSpfn @@ -1262,7 +1266,11 @@ moduleDefn: /* 'open' declarations */ | openDecl - { [SynModuleDecl.Open($1, $1.Range)] } + { [SynModuleDecl.Open($1, false, $1.Range)] } + + /* 'open type' declarations */ + | openTypeDecl + { [SynModuleDecl.Open($1, true, $1.Range)] } /* The right-hand-side of a module abbreviation definition */ @@ -2464,6 +2472,9 @@ exconRepr: openDecl: | OPEN path { $2 } +openTypeDecl: + | OPEN typeKeyword path { $3 } + /*-------------------------------------------------------------------------*/ /* F# Definitions, Types, Patterns and Expressions */ diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 31263f4e282..8b74f9efb50 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -844,14 +844,14 @@ type internal TypeCheckInfo | _ when IsAttribute infoReader cItem.Item -> true | _ -> false), denv, m) - | Some(CompletionContext.OpenDeclaration) -> + | Some(CompletionContext.OpenDeclaration isOpenType) -> GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck, false, getAllSymbols) |> Option.map (fun (items, denv, m) -> items |> List.filter (fun x -> match x.Item with - | Item.ModuleOrNamespaces _ -> true - | Item.Types (_, tcrefs) when tcrefs |> List.exists (fun ty -> isAppTy g ty && isStaticClass g (tcrefOfAppTy g ty)) -> true + | Item.ModuleOrNamespaces _ when not isOpenType -> true + | Item.Types (_, tcrefs) when isOpenType && tcrefs |> List.exists (fun ty -> isAppTy g ty) -> true | _ -> false), denv, m) // Completion at '(x: ...)" diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index 2d2739d95db..de9634741af 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -915,7 +915,7 @@ module ParsedInput = | SynModuleDecl.DoExpr (_, _, r) | SynModuleDecl.Types (_, r) | SynModuleDecl.Exception (_, r) - | SynModuleDecl.Open (_, r) + | SynModuleDecl.Open (_, _, r) | SynModuleDecl.HashDirective (_, r) -> Some r | _ -> None |> Option.map (fun r -> r.StartColumn) @@ -961,7 +961,7 @@ module ParsedInput = let moduleBodyIndentation = getMinColumn decls |> Option.defaultValue (range.StartColumn + 4) doRange NestedModule fullIdent range.StartLine moduleBodyIndentation List.iter (walkSynModuleDecl fullIdent) decls - | SynModuleDecl.Open (_, range) -> doRange OpenDeclaration [] range.EndLine (range.StartColumn - 5) + | SynModuleDecl.Open (_, _, range) -> doRange OpenDeclaration [] range.EndLine (range.StartColumn - 5) | SynModuleDecl.HashDirective (_, range) -> doRange HashDirective [] range.EndLine range.StartColumn | _ -> () diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index 698776bc014..5aa1bee12fc 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -181,7 +181,7 @@ module public AstTraversal = | SynModuleDecl.DoExpr(_sequencePointInfoForBinding, synExpr, _range) -> traverseSynExpr path synExpr | SynModuleDecl.Types(synTypeDefnList, _range) -> synTypeDefnList |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path)) |> pick decl | SynModuleDecl.Exception(_synExceptionDefn, _range) -> None - | SynModuleDecl.Open(_longIdent, _range) -> None + | SynModuleDecl.Open(_longIdent, _isOpenType, _range) -> None | SynModuleDecl.Attributes(_synAttributes, _range) -> None | SynModuleDecl.HashDirective(_parsedHashDirective, range) -> visitor.VisitHashDirective range | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace @@ -611,7 +611,7 @@ module public AstTraversal = let pick (debugObj:obj) = pick m.Range debugObj let path = TraverseStep.MemberDefn m :: path match m with - | SynMemberDefn.Open(_longIdent, _range) -> None + | SynMemberDefn.Open(_longIdent, _isOpenType, _range) -> None | SynMemberDefn.Member(synBinding, _range) -> traverseSynBinding path synBinding | SynMemberDefn.ImplicitCtor(_synAccessOption, _synAttributes, simplePats, _identOption, _range) -> match simplePats with diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index 2de95ace338..6e030ce75ea 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -586,7 +586,7 @@ module Structure = |> List.choose selectRanges |> acc.AddRange - let collectOpens = getConsecutiveModuleDecls (function SynModuleDecl.Open (_, r) -> Some r | _ -> None) Scope.Open + let collectOpens = getConsecutiveModuleDecls (function SynModuleDecl.Open (_, _, r) -> Some r | _ -> None) Scope.Open let collectHashDirectives = getConsecutiveModuleDecls( @@ -730,7 +730,7 @@ module Structure = | SynModuleSigDecl.Types (typeSigs, r) -> lastTypeDefnSigRangeElse r typeSigs | SynModuleSigDecl.Val (ValSpfn(range=r), _) -> r | SynModuleSigDecl.Exception(_, r) -> r - | SynModuleSigDecl.Open(_, r) -> r + | SynModuleSigDecl.Open(_, _, r) -> r | SynModuleSigDecl.ModuleAbbrev(_, _, r) -> r | _ -> range @@ -821,7 +821,7 @@ module Structure = Some (mkRange "" (mkPos r.StartLine prefixLength) r.End) | _ -> None) Scope.HashDirective - let collectSigOpens = getConsecutiveSigModuleDecls (function SynModuleSigDecl.Open (_, r) -> Some r | _ -> None) Scope.Open + let collectSigOpens = getConsecutiveSigModuleDecls (function SynModuleSigDecl.Open (_, _, r) -> Some r | _ -> None) Scope.Open let rec parseModuleSigDeclaration (decl: SynModuleSigDecl) = match decl with diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index b9902e67f46..eecdbbdf343 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -83,7 +83,7 @@ type CompletionContext = // end of name ast node * list of properties\parameters that were already set | ParameterList of pos * HashSet | AttributeApplication - | OpenDeclaration + | OpenDeclaration of isOpenType: bool /// completing pattern type (e.g. foo (x: |)) | PatternType @@ -1325,7 +1325,7 @@ module UntypedParseImpl = member __.VisitModuleDecl(defaultTraverse, decl) = match decl with - | SynModuleDecl.Open(_, m) -> + | SynModuleDecl.Open(_, isOpenType, m) -> // in theory, this means we're "in an open" // in practice, because the parse tree/walkers do not handle attributes well yet, need extra check below to ensure not e.g. $here$ // open System @@ -1334,7 +1334,7 @@ module UntypedParseImpl = // inside an attribute on the next item let pos = mkPos pos.Line (pos.Column - 1) // -1 because for e.g. "open System." the dot does not show up in the parse tree if rangeContainsPos m pos then - Some CompletionContext.OpenDeclaration + Some (CompletionContext.OpenDeclaration isOpenType) else None | _ -> defaultTraverse decl diff --git a/src/fsharp/service/ServiceUntypedParse.fsi b/src/fsharp/service/ServiceUntypedParse.fsi index 8213ec76294..b88bc0efec3 100755 --- a/src/fsharp/service/ServiceUntypedParse.fsi +++ b/src/fsharp/service/ServiceUntypedParse.fsi @@ -85,7 +85,7 @@ type public CompletionContext = | AttributeApplication - | OpenDeclaration + | OpenDeclaration of isOpenType: bool /// completing pattern type (e.g. foo (x: |)) | PatternType diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index f7ae174868e..a850949dd62 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index e086596e7b4..88976031efd 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 1eb408ff3f1..0bd2bfbd7ed 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 15bc9610834..06551c90dfe 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 41a4e672b8d..3e6a6f7353c 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 1dd7c03f820..02677df0184 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index b20e9912bbb..14348499d13 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index c05715de16d..d616391bdb9 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index 1e0e527e15f..10fe50f23f4 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index 21cef4e9e7e..7c8d7540d02 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index 136b9f3b8f5..7544aa4894d 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index 0a1d50ac1bb..f08688ee66f 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index 3da0fb2cca2..5e61947b55c 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -112,9 +112,9 @@ nullable optional interop - - open static classes - open static classes + + open type declaration + open type declaration diff --git a/tests/fsharp/Compiler/Language/OpenStaticClasses.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs similarity index 85% rename from tests/fsharp/Compiler/Language/OpenStaticClasses.fs rename to tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index bb257bc6c41..5649c50e075 100644 --- a/tests/fsharp/Compiler/Language/OpenStaticClasses.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -14,7 +14,7 @@ open FSharp.Test.Utilities.Utilities *) [] -module OpenStaticClassesTests = +module OpenTypeDeclarationTests = let baseModule = """ module Core_OpenStaticClasses @@ -37,13 +37,13 @@ type NotAllowedToOpen() = """ [] - let ``OpenStaticClassesTests - OpenSystemMathOnce - langversion:v4.6`` () = + let ``OpenSystemMathOnce - langversion:v4.6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ module OpenSystemMathOnce = - open System.Math + open type System.Math let x = Min(1.0, 2.0)""") [| (FSharpErrorSeverity.Error, 39, (22,28,22,32), "The namespace 'Math' is not defined."); @@ -51,27 +51,27 @@ module OpenSystemMathOnce = |] [] - let ``OpenStaticClassesTests - OpenSystemMathOnce - langversion:preview`` () = + let ``OpenSystemMathOnce - langversion:preview`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |] (baseModule + """ module OpenSystemMathOnce = - open System.Math + open type System.Math let x = Min(1.0, 2.0)""") [| |] [] - let ``OpenStaticClassesTests - OpenSystemMathTwice - langversion:v4.6`` () = + let ``OpenSystemMathTwice - langversion:v4.6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ module OpenSystemMathTwice = - open System.Math + open type System.Math let x = Min(1.0, 2.0) - open System.Math + open type System.Math let x2 = Min(2.0, 1.0)""") [| (FSharpErrorSeverity.Error, 39, (22,17,22,21), "The namespace 'Math' is not defined."); @@ -81,24 +81,24 @@ module OpenSystemMathTwice = |] [] - let ``OpenStaticClassesTests - OpenSystemMathTwice - langversion:preview`` () = + let ``OpenSystemMathTwice - langversion:preview`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |] (baseModule + """ module OpenSystemMathOnce = - open System.Math + open type System.Math let x = Min(1.0, 2.0)""") [| |] [] - let ``OpenStaticClassesTests - OpenMyMathOnce - langversion:v4.6`` () = + let ``OpenMyMathOnce - langversion:v4.6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ module OpenMyMathOnce = - open MyMath + open type MyMath let x = Min(1.0, 2.0) let x2 = Min(1, 2)""") [| @@ -108,19 +108,19 @@ module OpenMyMathOnce = |] [] - let ``OpenStaticClassesTests - OpenMyMathOnce - langversion:preview`` () = + let ``OpenMyMathOnce - langversion:preview`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |] (baseModule + """ module OpenMyMathOnce = - open MyMath + open type MyMath let x = Min(1.0, 2.0) let x2 = Min(1, 2)""") [| |] [] - let ``OpenStaticClassesTests - DontOpenAutoMath - langversion:v4.6`` () = + let ``DontOpenAutoMath - langversion:v4.6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ @@ -134,7 +134,7 @@ module DontOpenAutoMath = |] [] - let ``OpenStaticClassesTests - DontOpenAutoMath - langversion:preview`` () = + let ``DontOpenAutoMath - langversion:preview`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |] (baseModule + """ @@ -145,13 +145,13 @@ module DontOpenAutoMath = [| |] [] - let ``OpenStaticClassesTests - OpenAutoMath - langversion:v4.6`` () = + let ``OpenAutoMath - langversion:v4.6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ module OpenAutoMath = - open AutoOpenMyMath - //open NotAllowedToOpen + open type AutoOpenMyMath + //open type NotAllowedToOpen let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") @@ -162,25 +162,25 @@ module OpenAutoMath = |] [] - let ``OpenStaticClassesTests - OpenAutoMath - langversion:preview`` () = + let ``OpenAutoMath - langversion:preview`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |] (baseModule + """ module OpenAutoMath = - open AutoOpenMyMath - //open NotAllowedToOpen + open type AutoOpenMyMath + //open type NotAllowedToOpen let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") [| |] [] - let ``OpenStaticClassesTests - OpenAccessibleFields - langversion:preview`` () = + let ``OpenAccessibleFields - langversion:preview`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |] (baseModule + """ module OpenAFieldFromMath = - open System.Math + open type System.Math let pi = PI""") [||] @@ -217,7 +217,7 @@ namespace CSharpTest namespace FSharpTest open System -open CSharpTest.Test +open type CSharpTest.Test module Test = let x = NestedTest() @@ -236,7 +236,7 @@ module Test = CompilerAssert.Compile(fsCmpl) [] - let ``Open generic type and use nested types as unqualified`` () = + let ``Open generic type and use nested types as unqualified - Error`` () = let csharpSource = """ using System; @@ -269,7 +269,7 @@ namespace CSharpTest namespace FSharpTest open System -open CSharpTest.Test +open type CSharpTest.Test module Test = let x = NestedTest() @@ -285,7 +285,9 @@ module Test = let fsCmpl = Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - CompilerAssert.Compile(fsCmpl) + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 10, (5, 26, 5, 27), "Unexpected type application in implementation file. Expected incomplete structured construct at or before this point or other token.") + |]) // TODO - wait for Will's integration of testing changes that makes this easlier // [] diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 91f242d059c..6e3af1fae74 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -66,7 +66,7 @@ - + From b5ecdd87997249f1e5922ca90bb8deb47363604c Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 22 Jun 2020 18:39:57 -0700 Subject: [PATCH 04/89] Added more tests --- .../Language/OpenTypeDeclarationTests.fs | 80 +++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 5649c50e075..332e66fb11e 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -235,6 +235,46 @@ module Test = CompilerAssert.Compile(fsCmpl) + [] + let ``Open a nested type as qualified`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public static void A() + { + } + } + } +} + """ + + let fsharpSource = + """ +namespace FSharpTest + +open System +open type CSharpTest.Test.NestedTest + +module Test = + let x = A() + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) + + CompilerAssert.Compile(fsCmpl) + [] let ``Open generic type and use nested types as unqualified - Error`` () = let csharpSource = @@ -289,6 +329,46 @@ module Test = (FSharpErrorSeverity.Error, 10, (5, 26, 5, 27), "Unexpected type application in implementation file. Expected incomplete structured construct at or before this point or other token.") |]) + [] + let ``Using the 'open' declaration on a possible type identifier - Error`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public static void A() + { + } + } +} + """ + + let fsharpSource = + """ +namespace FSharpTest + +open System +open CSharpTest.Test + +module Test = + let x = A() + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) + + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 39, (5, 17, 5, 21), "The namespace 'Test' is not defined.") + (FSharpErrorSeverity.Error, 39, (8, 13, 8, 14), "The value or constructor 'A' is not defined.") + |]) + // TODO - wait for Will's integration of testing changes that makes this easlier // [] // let ``OpenStaticClassesTests - InternalsVisibleWhenHavingAnIVT - langversion:preview``() = ... From ed170c0f875d590b55279ec08a86ee465b7b2ad8 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 22 Jun 2020 18:51:46 -0700 Subject: [PATCH 05/89] Fixing build --- tests/service/InteractiveCheckerTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index f03127bb8a7..014d5a138c6 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -42,7 +42,7 @@ let internal identsAndRanges (input: ParsedInput) = | SynModuleDecl.Let(_, _, _) -> failwith "Not implemented yet" | SynModuleDecl.DoExpr(_, _, _range) -> failwith "Not implemented yet" | SynModuleDecl.Exception(_, _range) -> failwith "Not implemented yet" - | SynModuleDecl.Open(longIdentWithDots, range) -> [ identAndRange (longIdentWithDotsToString longIdentWithDots) range ] + | SynModuleDecl.Open(longIdentWithDots, _, range) -> [ identAndRange (longIdentWithDotsToString longIdentWithDots) range ] | SynModuleDecl.Attributes(_attrs, _range) -> failwith "Not implemented yet" | SynModuleDecl.HashDirective(_, _range) -> failwith "Not implemented yet" | SynModuleDecl.NamespaceFragment(moduleOrNamespace) -> extractFromModuleOrNamespace moduleOrNamespace From 3987aea921ee426de6c1bedf9d9f2231daaafc45 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 23 Jun 2020 03:56:53 -0700 Subject: [PATCH 06/89] Added tooling support --- src/fsharp/NameResolution.fs | 76 +++++++++++++------ src/fsharp/TypeChecker.fs | 5 +- src/fsharp/service/FSharpCheckerResults.fs | 7 +- src/fsharp/service/SemanticClassification.fs | 3 +- src/fsharp/service/ServiceAnalysis.fs | 22 ++++-- src/fsharp/symbols/Symbols.fs | 8 ++ src/fsharp/symbols/Symbols.fsi | 3 + .../Language/DefaultInterfaceMemberTests.fs | 15 ++-- .../Language/OpenTypeDeclarationTests.fs | 41 +++++++--- 9 files changed, 129 insertions(+), 51 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index c4f98b8e0f3..9de66bba3c3 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2115,16 +2115,30 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection | id2 :: rest2 -> ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl isType else - let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified - let namespaceNotFound = lazy( - let suggestModulesAndNamespaces (addToBuffer: string -> unit) = - for kv in moduleOrNamespaces do - for modref in kv.Value do - if IsEntityAccessible amap m ad modref then - addToBuffer modref.DisplayName - addToBuffer modref.DemangledModuleOrNamespaceName + let notFoundAux (id: Ident) depth error (tcrefs: TyconRef seq) = + let suggestNames (addToBuffer: string -> unit) = + for tcref in tcrefs do + if IsEntityAccessible amap m ad tcref then + addToBuffer tcref.DisplayName + addToBuffer tcref.DemangledModuleOrNamespaceName + + UndefinedName(depth, error, id, suggestNames) - UndefinedName(0, FSComp.SR.undefinedNameNamespaceOrModule, id, suggestModulesAndNamespaces)) + let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified + let namespaceNotFound = + lazy + if isType then + seq { for kv in nenv.TyconsByDemangledNameAndArity fullyQualified do + match kv.Key with + // We choose arity 0 as F# does not support opening parameterized types. + | NameArityPair(_, 0) -> kv.Value + | _ -> () } + |> notFoundAux id 0 FSComp.SR.undefinedNameType + else + seq { for kv in moduleOrNamespaces do + for modref in kv.Value do + modref } + |> notFoundAux id 0 FSComp.SR.undefinedNameNamespaceOrModule // Avoid generating the same error and name suggestion thunk twice It's not clear this is necessary // since it's just saving an allocation. @@ -2133,18 +2147,28 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection match moduleNotFoundErrorCache with | Some (oldId, error) when Range.equals oldId id.idRange -> error | _ -> - let suggestNames (addToBuffer: string -> unit) = - for kv in mty.ModulesAndNamespacesByDemangledName do - if IsEntityAccessible amap m ad (modref.NestedTyconRef kv.Value) then - addToBuffer kv.Value.DisplayName - addToBuffer kv.Value.DemangledModuleOrNamespaceName - - let error = raze (UndefinedName(depth, FSComp.SR.undefinedNameNamespace, id, suggestNames)) + let error = + if isType then + seq { for kv in mty.TypesByDemangledNameAndArity m do + match kv.Key with + | NameArityPair(_, 0) -> modref.NestedTyconRef kv.Value + | _ -> () } + |> notFoundAux id depth FSComp.SR.undefinedNameType + else + seq { for kv in mty.ModulesAndNamespacesByDemangledName do + modref.NestedTyconRef kv.Value } + |> notFoundAux id depth FSComp.SR.undefinedNameNamespace + let error = raze error moduleNotFoundErrorCache <- Some(id.idRange, error) error - let notifyNameResolution (modref: ModuleOrNamespaceRef) m = - let item = Item.ModuleOrNamespaces [modref] + let notifyNameResolution nm (modref: ModuleOrNamespaceRef) m = + let item = + if isType && not modref.IsModuleOrNamespace then + // F# does not support opening parameterized types. + Item.Types (nm, [generalizedTyconRef modref]) + else + Item.ModuleOrNamespaces [modref] let occurence = if isOpenDecl then ItemOccurence.Open else ItemOccurence.Use CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occurence, ad) @@ -2161,7 +2185,9 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection let tcrefs = if isType then + // F# does not support opening parameterized types. LookupTypeNameInEnvNoArity fullyQualified id.idText nenv + |> List.filter (fun x -> x.TyparsNoRange.IsEmpty) else [] @@ -2178,6 +2204,8 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection | id :: rest -> let especs = let modrefs = + // If we are not resolving a type, then always resolve a module or namespace. + // If we are resolving a type, but the rest is not empty, we might need to resolve a module or namespace. if not isType || (isType && not rest.IsEmpty) then match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with | true, res -> [res] @@ -2187,7 +2215,9 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection let tcrefs = if isType then + // F# does not support opening parameterized types. LookupTypeNameInEntityNoArity id.idRange id.idText mty + |> List.filter (fun x -> x.TyparsNoRange.IsEmpty) else [] @@ -2198,7 +2228,7 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection |> List.map (fun espec -> let subref = modref.NestedTyconRef espec if IsEntityAccessible amap m ad subref then - notifyNameResolution subref id.idRange + notifyNameResolution id.idText subref id.idRange look (depth+1) subref rest else moduleNotFound modref mty id depth) @@ -2209,7 +2239,7 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection erefs |> List.map (fun eref -> if IsEntityAccessible amap m ad eref then - notifyNameResolution eref id.idRange + notifyNameResolution id.idText eref id.idRange look 1 eref rest else raze (namespaceNotFound.Force())) @@ -2236,11 +2266,7 @@ let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified /// Perform name resolution for an identifier which must resolve to be a type to be used as a module or namespace. let ResolveTypeLongIdentAsModuleOrNamespace sink atMostOne (amap: Import.ImportMap) m first fullyQualified nenv ad id rest isOpenDecl = - let g = amap.g - if tryLanguageFeatureErrorRecover g.langVersion LanguageFeature.OpenTypeDeclaration m then - ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl true - else - NoResultsOrUsefulErrors + ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl true //------------------------------------------------------------------------- // Bind name used in "new Foo.Bar(...)" constructs diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 4b34cce3999..4fd0d2201c3 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -12951,7 +12951,10 @@ let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) isOpenTy | Exception err -> errorR(err); [] -let TcOpenDecl tcSink g amap m scopem env longId isOpenType = +let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env longId isOpenType = + if isOpenType then + checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration m + match TcOpenLidAndPermitAutoResolve tcSink env amap longId isOpenType with | [] -> env | modrefs -> diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 8b74f9efb50..863b3e6931e 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -850,8 +850,11 @@ type internal TypeCheckInfo items |> List.filter (fun x -> match x.Item with - | Item.ModuleOrNamespaces _ when not isOpenType -> true - | Item.Types (_, tcrefs) when isOpenType && tcrefs |> List.exists (fun ty -> isAppTy g ty) -> true + | Item.ModuleOrNamespaces _ -> true + | Item.Types (_, tcrefs) + when isOpenType && + g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && + tcrefs |> List.exists (fun ty -> isAppTy g ty) -> true | _ -> false), denv, m) // Completion at '(x: ...)" diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 367d2290122..a58badda4f6 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -53,7 +53,8 @@ module TcResolutionsExtensions = | ItemOccurence.UseInAttribute | ItemOccurence.Use _ | ItemOccurence.Binding _ - | ItemOccurence.Pattern _ -> Some() + | ItemOccurence.Pattern _ + | ItemOccurence.Open -> Some() | _ -> None let (|OptionalArgumentAttribute|_|) ttype = diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index 69d2d774669..ff3420391a4 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -85,7 +85,19 @@ module UnusedOpens = if firstId.idText = MangledGlobalName then None else - Some { OpenedGroups = openDecl.Modules |> List.map OpenedModuleGroup.Create + Some { OpenedGroups = + openDecl.Modules + |> List.map (fun entity -> + if entity.IsFSharpAbbreviation then + let ty = entity.AbbreviatedType + let ty2 = + if ty.HasTypeDefinition && ty.IsAbbreviation then + ty.AbbreviatedType + else + ty + OpenedModuleGroup.Create ty2.TypeDefinition + else + OpenedModuleGroup.Create entity) Range = range AppliedScope = openDecl.AppliedScope } | _ -> None) @@ -136,7 +148,7 @@ module UnusedOpens = match symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some ent when ent.IsNamespace || ent.IsFSharpModule -> true + | Some ent when ent.IsNamespace || ent.IsFSharpModule || ent.IsType -> true | _ -> false | _ -> false) @@ -204,14 +216,14 @@ module UnusedOpens = /// Async to allow cancellation. let filterOpenStatements (symbolUses1: FSharpSymbolUse[], symbolUses2: FSharpSymbolUse[]) openStatements = async { - // the key is a namespace or module, the value is a list of FSharpSymbolUse range of symbols defined in the - // namespace or module. So, it's just symbol uses ranges grouped by namespace or module where they are _defined_. + // the key is a namespace or module or type, the value is a list of FSharpSymbolUse range of symbols defined in the + // namespace or module or type. So, it's just symbol uses ranges grouped by namespace or module where they are _defined_. let symbolUsesRangesByDeclaringEntity = Dictionary(entityHash) for symbolUse in symbolUses1 do match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some entity when entity.IsNamespace || entity.IsFSharpModule -> + | Some entity when entity.IsNamespace || entity.IsFSharpModule || entity.IsType -> symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.RangeAlternate) | _ -> () | _ -> () diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index f387a9bc7e1..0fb7411a8c1 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -532,6 +532,14 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member __.IsFSharpUnion = isResolvedAndFSharp() && entity.IsUnionTycon + member __.IsType = + isResolved() && + (entity.IsILTycon || + entity.IsFSharpObjectModelTycon || + entity.IsFSharpDelegateTycon || + entity.IsFSharpInterfaceTycon || + entity.IsFSharpStructOrEnumTycon) + member __.HasAssemblyCodeRepresentation = isResolvedAndFSharp() && (entity.IsAsmReprTycon || entity.IsMeasureableReprTycon) diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 4f8313c7919..5b295a0fc24 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -190,6 +190,9 @@ and [] public FSharpEntity = /// Indicates if the entity is union type member IsFSharpUnion : bool + /// Indicates if the entity is a type + member IsType : bool + /// Indicates if the entity is a struct or enum member IsValueType : bool diff --git a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs index fbd968178f1..02ab3ed8361 100644 --- a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs +++ b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs @@ -7,17 +7,14 @@ open FSharp.Test.Utilities open FSharp.Test.Utilities.Utilities open FSharp.Compiler.SourceCodeServices -[] -module private DefaultInterfaceMemberConsumptionLanguageVersion = - - [] - let targetVersion = "'preview'" - #if NETCOREAPP [] module DefaultInterfaceMemberConsumptionTests_LanguageVersion_4_6 = + [] + let targetVersion = "'preview'" + [] let ``IL - Errors with lang version not supported`` () = let ilSource = @@ -949,6 +946,9 @@ type Test2 () = [] module DefaultInterfaceMemberConsumptionTests_LanguageVersion_4_6_net472 = + [] + let targetVersion = "'preview'" + [] let ``IL - Errors with lang version and target runtime not supported`` () = let ilSource = @@ -4957,6 +4957,9 @@ let f () = [] module DefaultInterfaceMemberConsumptionTests_net472 = + [] + let targetVersion = "'preview'" + [] let ``IL - Errors with target runtime not supported`` () = let ilSource = diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 332e66fb11e..d33030104d9 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -16,6 +16,9 @@ open FSharp.Test.Utilities.Utilities [] module OpenTypeDeclarationTests = + [] + let targetVersion = "'preview'" + let baseModule = """ module Core_OpenStaticClasses @@ -37,7 +40,7 @@ type NotAllowedToOpen() = """ [] - let ``OpenSystemMathOnce - langversion:v4.6`` () = + let ``OpenSystemMathOnce - langversion:v4_6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ @@ -46,7 +49,7 @@ module OpenSystemMathOnce = open type System.Math let x = Min(1.0, 2.0)""") [| - (FSharpErrorSeverity.Error, 39, (22,28,22,32), "The namespace 'Math' is not defined."); + (FSharpErrorSeverity.Error, 3350, (22, 26, 22, 37), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (23,24,23,27), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") |] @@ -62,7 +65,7 @@ module OpenSystemMathOnce = [| |] [] - let ``OpenSystemMathTwice - langversion:v4.6`` () = + let ``OpenSystemMathTwice - langversion:v4_6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ @@ -74,9 +77,9 @@ module OpenSystemMathTwice = open type System.Math let x2 = Min(2.0, 1.0)""") [| - (FSharpErrorSeverity.Error, 39, (22,17,22,21), "The namespace 'Math' is not defined."); + (FSharpErrorSeverity.Error, 3350, (22, 15, 22, 26), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (23,13,23,16), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") - (FSharpErrorSeverity.Error, 39, (25,17,25,21), "The namespace 'Math' is not defined."); + (FSharpErrorSeverity.Error, 3350, (25, 15, 25, 26), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (26,14,26,17), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") |] @@ -92,7 +95,7 @@ module OpenSystemMathOnce = [| |] [] - let ``OpenMyMathOnce - langversion:v4.6`` () = + let ``OpenMyMathOnce - langversion:v4_6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ @@ -102,7 +105,7 @@ module OpenMyMathOnce = let x = Min(1.0, 2.0) let x2 = Min(1, 2)""") [| - (FSharpErrorSeverity.Error, 39, (22,10,22,16), "The namespace or module 'MyMath' is not defined. Maybe you want one of the following:\r\n Math"); + (FSharpErrorSeverity.Error, 3350, (22, 15, 22, 21), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (23,13,23,16), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") (FSharpErrorSeverity.Error, 39, (24,14,24,17), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") |] @@ -120,7 +123,7 @@ module OpenMyMathOnce = [| |] [] - let ``DontOpenAutoMath - langversion:v4.6`` () = + let ``DontOpenAutoMath - langversion:v4_6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ @@ -129,7 +132,7 @@ module DontOpenAutoMath = let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") [| - (FSharpErrorSeverity.Error, 39, (22,13,22,20), "The value or constructor 'AutoMin' is not defined."); + (FSharpErrorSeverity.Error, 39, (22,13,22,20), "The value or constructor 'AutoMin' is not defined.") (FSharpErrorSeverity.Error, 39, (23,14,23,21), "The value or constructor 'AutoMin' is not defined.") |] @@ -145,7 +148,7 @@ module DontOpenAutoMath = [| |] [] - let ``OpenAutoMath - langversion:v4.6`` () = + let ``OpenAutoMath - langversion:v4_6`` () = CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:4.6" |] (baseModule + """ @@ -156,7 +159,7 @@ module OpenAutoMath = let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") [| - (FSharpErrorSeverity.Error, 39, (21,10,21,24), "The namespace or module 'AutoOpenMyMath' is not defined."); + (FSharpErrorSeverity.Error, 3350, (21, 15, 21, 29), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (24,13,24,20), "The value or constructor 'AutoMin' is not defined.") (FSharpErrorSeverity.Error, 39, (25,14,25,21), "The value or constructor 'AutoMin' is not defined.") |] @@ -369,6 +372,22 @@ module Test = (FSharpErrorSeverity.Error, 39, (8, 13, 8, 14), "The value or constructor 'A' is not defined.") |]) + [] + let ``Open type declaration on a namespace - Error`` () = + let fsharpSource = + """ +namespace FSharpTest + +open type System + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|]) + + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 39, (4, 11, 4, 17), "The type 'System' is not defined.") + |]) + // TODO - wait for Will's integration of testing changes that makes this easlier // [] // let ``OpenStaticClassesTests - InternalsVisibleWhenHavingAnIVT - langversion:preview``() = ... From 0ec3f635c64cbfaefdcddbfe05b291b8875073c6 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 23 Jun 2020 16:18:34 -0700 Subject: [PATCH 07/89] More updates --- src/fsharp/NameResolution.fs | 21 ++++++++-------- src/fsharp/TypedTree.fs | 12 ++++++++++ src/fsharp/TypedTreeOps.fs | 24 +++++++++++++++++++ src/fsharp/TypedTreeOps.fsi | 2 ++ src/fsharp/service/FSharpCheckerResults.fs | 8 +++++-- src/fsharp/service/ServiceAnalysis.fs | 28 +++++++--------------- src/fsharp/symbols/Symbols.fs | 9 ++----- src/fsharp/symbols/Symbols.fsi | 4 ++-- 8 files changed, 66 insertions(+), 42 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 9de66bba3c3..dce80c1098e 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2106,6 +2106,11 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities // Consume ids that refer to a namespace, module, or type //------------------------------------------------------------------------- +/// If we are not looking up a type, then always lookup a module or namespace. +/// If we are looking up a type, but the rest is not empty, we need to lookup a module or namespace. +let CanLookupModuleOrNamespace (rest: Ident list) isType = + not isType || (isType && not rest.IsEmpty) + /// Perform name resolution for an identifier which must resolve to be a module or namespace. let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl isType = if first && id.idText = MangledGlobalName then @@ -2174,9 +2179,7 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection let erefs = let modrefs = - // If we are not resolving a type, then always resolve a module or namespace. - // If we are resolving a type, but the rest is not empty, we might need to resolve a module or namespace. - if not isType || (isType && not rest.IsEmpty) then + if CanLookupModuleOrNamespace rest isType then match moduleOrNamespaces.TryGetValue id.idText with | true, modrefs -> modrefs | _ -> [] @@ -2185,9 +2188,8 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection let tcrefs = if isType then - // F# does not support opening parameterized types. LookupTypeNameInEnvNoArity fullyQualified id.idText nenv - |> List.filter (fun x -> x.TyparsNoRange.IsEmpty) + |> List.filter (fun x -> isOpenableTycon x.Deref) else [] @@ -2204,9 +2206,7 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection | id :: rest -> let especs = let modrefs = - // If we are not resolving a type, then always resolve a module or namespace. - // If we are resolving a type, but the rest is not empty, we might need to resolve a module or namespace. - if not isType || (isType && not rest.IsEmpty) then + if CanLookupModuleOrNamespace rest isType then match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with | true, res -> [res] | _ -> [] @@ -2215,9 +2215,8 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection let tcrefs = if isType then - // F# does not support opening parameterized types. LookupTypeNameInEntityNoArity id.idRange id.idText mty - |> List.filter (fun x -> x.TyparsNoRange.IsEmpty) + |> List.filter isOpenableTycon else [] @@ -2264,7 +2263,7 @@ let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified f resInfo (depth+1) id.idRange modref mty id2 rest2) | Exception err -> Exception err -/// Perform name resolution for an identifier which must resolve to be a type to be used as a module or namespace. +/// Perform name resolution for an identifier which must resolve to be a type to be used like a module or namespace. let ResolveTypeLongIdentAsModuleOrNamespace sink atMostOne (amap: Import.ImportMap) m first fullyQualified nenv ad id rest isOpenDecl = ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl true diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index f0aeb5bf7bb..22b162ee70a 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -1082,6 +1082,12 @@ type Entity = /// Indicates if this is an F#-defined class type definition member x.IsFSharpClassTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconClass -> true | _ -> false + /// Indicates if this is a .NET-defined delegate type definition + member x.IsILDelegateTycon = x.IsILTycon && x.ILTyconRawMetadata.IsDelegate + + /// Indicates if this is a delegate type definition + member x.IsDelegateTycon = x.IsFSharpDelegateTycon || x.IsILDelegateTycon + /// Indicates if this is a .NET-defined enum type definition member x.IsILEnumTycon = x.IsILTycon && x.ILTyconRawMetadata.IsEnum @@ -3541,6 +3547,12 @@ type EntityRef = /// Indicates if this is an F#-defined enum type definition member x.IsFSharpEnumTycon = x.Deref.IsFSharpEnumTycon + /// Indicates if this is a .NET-defined delegate type definition + member x.IsILDelegateTycon = x.Deref.IsILDelegateTycon + + /// Indicates if this is a delegate type definition + member x.IsDelegateTycon = x.Deref.IsDelegateTycon + /// Indicates if this is a .NET-defined enum type definition member x.IsILEnumTycon = x.Deref.IsILEnumTycon diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 791eaad2a3b..f05e6630690 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -3138,6 +3138,30 @@ let destReadOnlySpanTy g m ty = | ValueSome(struct(tcref, ty)) -> struct(tcref, ty) | _ -> failwith "destReadOnlySpanTy" +/// Is the type able to be opened? +/// F# does not support opening the following types: +/// - parameterized types +/// - type abbreviations +/// - measureable types +/// - special types from FSharp.Core +/// - delegate types +/// - hidden types +/// - erased types +/// - F# exception types +/// parameterized types, type abbreviations, measureable types, or special types from FSharp.Core. +let isOpenableTycon (tycon: Tycon) = + // While a Tycon is an Entity and an Entity that is a module or namespace can be opened, + // we disallow it here to be explicit that this function only operates on type definitions. + not tycon.IsModuleOrNamespace && + tycon.TyparsNoRange.IsEmpty && + not tycon.IsTypeAbbrev && + not tycon.IsMeasureableReprTycon && + not tycon.IsAsmReprTycon && + not tycon.IsDelegateTycon && + not tycon.IsHiddenReprTycon && + not tycon.IsErased && + not tycon.IsExceptionDecl + //------------------------------------------------------------------------- // List and reference types... //------------------------------------------------------------------------- diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 27394627a98..f6d2c88d73b 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2142,6 +2142,8 @@ val tryDestReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TTy val destReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) +val isOpenableTycon : Tycon -> bool + //------------------------------------------------------------------------- // Tuple constructors/destructors //------------------------------------------------------------------------- diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 863b3e6931e..078d09a38d2 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -853,8 +853,12 @@ type internal TypeCheckInfo | Item.ModuleOrNamespaces _ -> true | Item.Types (_, tcrefs) when isOpenType && - g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && - tcrefs |> List.exists (fun ty -> isAppTy g ty) -> true + tcrefs + |> List.exists (fun ty -> + match ty with + | TType_app (tcref, _) when tcref.CanDeref -> + not tcref.IsTypeAbbrev && (isOpenableTycon tcref.Deref || (* IL types might have nested types *) (tcref.IsILTycon && not tcref.IsILDelegateTycon)) + | _ -> false) -> true | _ -> false), denv, m) // Completion at '(x: ...)" diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index ff3420391a4..47e2175dc35 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -13,10 +13,10 @@ module UnusedOpens = let symbolHash = HashIdentity.FromFunctions (fun (x: FSharpSymbol) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) - /// Represents one namespace or module opened by an 'open' statement + /// Represents one namespace or module or type opened by an 'open'/'open type' declaration type OpenedModule(entity: FSharpEntity, isNestedAutoOpen: bool) = - /// Compute an indexed table of the set of symbols revealed by 'open', on-demand + /// Compute an indexed table of the set of symbols revealed by 'open'/'open type', on-demand let revealedSymbols : Lazy> = lazy let symbols = @@ -42,8 +42,8 @@ module UnusedOpens = for apCase in entity.ActivePatternCases do yield apCase :> FSharpSymbol - // The IsNamespace and IsFSharpModule cases are handled by looking at DeclaringEntity below - if not entity.IsNamespace && not entity.IsFSharpModule then + // The IsNamespace and IsFSharpModule and IsOpenableType cases are handled by looking at DeclaringEntity below + if not entity.IsNamespace && not entity.IsFSharpModule && not entity.IsOpenableType then for fv in entity.MembersFunctionsAndValues do yield fv :> FSharpSymbol |] @@ -60,7 +60,7 @@ module UnusedOpens = let rec getModuleAndItsAutoOpens (isNestedAutoOpen: bool) (modul: FSharpEntity) = [ yield OpenedModule (modul, isNestedAutoOpen) for ent in modul.NestedEntities do - if ent.IsFSharpModule && Symbol.hasAttribute ent.Attributes then + if (ent.IsFSharpModule || ent.IsOpenableType) && Symbol.hasAttribute ent.Attributes then yield! getModuleAndItsAutoOpens true ent ] { OpenedModules = getModuleAndItsAutoOpens false modul } @@ -85,19 +85,7 @@ module UnusedOpens = if firstId.idText = MangledGlobalName then None else - Some { OpenedGroups = - openDecl.Modules - |> List.map (fun entity -> - if entity.IsFSharpAbbreviation then - let ty = entity.AbbreviatedType - let ty2 = - if ty.HasTypeDefinition && ty.IsAbbreviation then - ty.AbbreviatedType - else - ty - OpenedModuleGroup.Create ty2.TypeDefinition - else - OpenedModuleGroup.Create entity) + Some { OpenedGroups = openDecl.Modules |> List.map OpenedModuleGroup.Create Range = range AppliedScope = openDecl.AppliedScope } | _ -> None) @@ -148,7 +136,7 @@ module UnusedOpens = match symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some ent when ent.IsNamespace || ent.IsFSharpModule || ent.IsType -> true + | Some ent when ent.IsNamespace || ent.IsFSharpModule || ent.IsOpenableType -> true | _ -> false | _ -> false) @@ -223,7 +211,7 @@ module UnusedOpens = match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some entity when entity.IsNamespace || entity.IsFSharpModule || entity.IsType -> + | Some entity when entity.IsNamespace || entity.IsFSharpModule || entity.IsOpenableType -> symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.RangeAlternate) | _ -> () | _ -> () diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 0fb7411a8c1..cd1a1a83d81 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -532,13 +532,8 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member __.IsFSharpUnion = isResolvedAndFSharp() && entity.IsUnionTycon - member __.IsType = - isResolved() && - (entity.IsILTycon || - entity.IsFSharpObjectModelTycon || - entity.IsFSharpDelegateTycon || - entity.IsFSharpInterfaceTycon || - entity.IsFSharpStructOrEnumTycon) + member __.IsOpenableType = + isResolved() && isOpenableTycon entity.Deref member __.HasAssemblyCodeRepresentation = isResolvedAndFSharp() && (entity.IsAsmReprTycon || entity.IsMeasureableReprTycon) diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 5b295a0fc24..de71cbd35b0 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -190,8 +190,8 @@ and [] public FSharpEntity = /// Indicates if the entity is union type member IsFSharpUnion : bool - /// Indicates if the entity is a type - member IsType : bool + /// Indicates if the entity is a type that can be opened via 'open type' declarations + member IsOpenableType : bool /// Indicates if the entity is a struct or enum member IsValueType : bool From f928b2f7982d53c747d682ebad0d94c9bf7ad658 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 24 Jun 2020 02:17:59 -0700 Subject: [PATCH 08/89] Some refactor --- src/fsharp/NameResolution.fs | 33 ++++--- src/fsharp/TypedTreeOps.fs | 20 ++-- src/fsharp/TypedTreeOps.fsi | 2 +- src/fsharp/service/FSharpCheckerResults.fs | 3 +- src/fsharp/service/ServiceAnalysis.fs | 4 +- src/fsharp/symbols/Symbols.fs | 2 +- .../Language/OpenTypeDeclarationTests.fs | 93 ++++++++++++++++++- 7 files changed, 128 insertions(+), 29 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index dce80c1098e..b9c6a3ec6d5 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2106,6 +2106,14 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities // Consume ids that refer to a namespace, module, or type //------------------------------------------------------------------------- +let ResolveNestedTypeThroughAbbreviation g (tcref: TyconRef) m = + if tcref.IsTypeAbbrev && tcref.Typars(m).IsEmpty then + match tryAppTy g tcref.TypeAbbrev.Value with + | ValueSome (abbrevTcref, []) -> abbrevTcref + | _ -> tcref + else + tcref + /// If we are not looking up a type, then always lookup a module or namespace. /// If we are looking up a type, but the rest is not empty, we need to lookup a module or namespace. let CanLookupModuleOrNamespace (rest: Ident list) isType = @@ -2113,6 +2121,8 @@ let CanLookupModuleOrNamespace (rest: Ident list) isType = /// Perform name resolution for an identifier which must resolve to be a module or namespace. let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl isType = + let g = amap.g + if first && id.idText = MangledGlobalName then match rest with | [] -> @@ -2189,7 +2199,6 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection let tcrefs = if isType then LookupTypeNameInEnvNoArity fullyQualified id.idText nenv - |> List.filter (fun x -> isOpenableTycon x.Deref) else [] @@ -2198,10 +2207,14 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection if not erefs.IsEmpty then /// Look through the sub-namespaces and/or modules let rec look depth (modref: ModuleOrNamespaceRef) (lid: Ident list) = + let modref = if not lid.IsEmpty then ResolveNestedTypeThroughAbbreviation g modref m else modref let mty = modref.ModuleOrNamespaceType match lid with | [] -> - success [ (depth, modref, mty) ] + if isType && not (isOpenableTyconRef modref) then + moduleNotFound modref mty id depth + else + success [ (depth, modref, mty) ] | id :: rest -> let especs = @@ -2216,7 +2229,6 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection let tcrefs = if isType then LookupTypeNameInEntityNoArity id.idRange id.idText mty - |> List.filter isOpenableTycon else [] @@ -3025,17 +3037,10 @@ let ResolvePatternLongIdent sink (ncenv: NameResolver) warnOnUpper newDef m ad n // // X.ListEnumerator // does not resolve // -let ResolveNestedTypeThroughAbbreviation (ncenv: NameResolver) (tcref: TyconRef) m = - if tcref.IsTypeAbbrev && tcref.Typars(m).IsEmpty then - match tryAppTy ncenv.g tcref.TypeAbbrev.Value with - | ValueSome (abbrevTcref, []) -> abbrevTcref - | _ -> tcref - else - tcref /// Resolve a long identifier representing a type name let rec ResolveTypeLongIdentInTyconRefPrim (ncenv: NameResolver) (typeNameResInfo: TypeNameResolutionInfo) ad resInfo genOk depth m (tcref: TyconRef) (id: Ident) (rest: Ident list) = - let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m + let tcref = ResolveNestedTypeThroughAbbreviation ncenv.g tcref m match rest with | [] -> #if !NO_EXTENSIONTYPING @@ -4171,7 +4176,7 @@ let TryToResolveLongIdentAsType (ncenv: NameResolver) (nenv: NameResolutionEnv) LookupTypeNameInEnvNoArity OpenQualified id nenv |> List.tryHead |> Option.map (fun tcref -> - let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m + let tcref = ResolveNestedTypeThroughAbbreviation g tcref m FreshenTycon ncenv m tcref) | _ -> None @@ -4268,7 +4273,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE [ if not isItemVal then // type.lookup: lookup a static something in a type for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do - let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m + let tcref = ResolveNestedTypeThroughAbbreviation g tcref m let ty = FreshenTycon ncenv m tcref yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty ] @@ -4852,7 +4857,7 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a | _ -> // type.lookup: lookup a static something in a type for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do - let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m + let tcref = ResolveNestedTypeThroughAbbreviation g tcref m let ty = FreshenTycon ncenv m tcref yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item ty } diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index f05e6630690..dc61d14983d 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -3149,18 +3149,18 @@ let destReadOnlySpanTy g m ty = /// - erased types /// - F# exception types /// parameterized types, type abbreviations, measureable types, or special types from FSharp.Core. -let isOpenableTycon (tycon: Tycon) = +let isOpenableTyconRef (tcref: TyconRef) = // While a Tycon is an Entity and an Entity that is a module or namespace can be opened, // we disallow it here to be explicit that this function only operates on type definitions. - not tycon.IsModuleOrNamespace && - tycon.TyparsNoRange.IsEmpty && - not tycon.IsTypeAbbrev && - not tycon.IsMeasureableReprTycon && - not tycon.IsAsmReprTycon && - not tycon.IsDelegateTycon && - not tycon.IsHiddenReprTycon && - not tycon.IsErased && - not tycon.IsExceptionDecl + not tcref.IsModuleOrNamespace && + tcref.TyparsNoRange.IsEmpty && + not tcref.IsTypeAbbrev && + not tcref.IsMeasureableReprTycon && + not tcref.IsAsmReprTycon && + not tcref.IsDelegateTycon && + not tcref.IsHiddenReprTycon && + not tcref.IsErased && + not tcref.IsExceptionDecl //------------------------------------------------------------------------- // List and reference types... diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index f6d2c88d73b..74503b5f1b1 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2142,7 +2142,7 @@ val tryDestReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TTy val destReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) -val isOpenableTycon : Tycon -> bool +val isOpenableTyconRef : TyconRef -> bool //------------------------------------------------------------------------- // Tuple constructors/destructors diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 078d09a38d2..899ef1947f6 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -857,7 +857,8 @@ type internal TypeCheckInfo |> List.exists (fun ty -> match ty with | TType_app (tcref, _) when tcref.CanDeref -> - not tcref.IsTypeAbbrev && (isOpenableTycon tcref.Deref || (* IL types might have nested types *) (tcref.IsILTycon && not tcref.IsILDelegateTycon)) + // Type abbreviations may have nested types that are valid, so show them. + tcref.IsTypeAbbrev || isOpenableTyconRef tcref | _ -> false) -> true | _ -> false), denv, m) diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index 47e2175dc35..172987c7e88 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -211,7 +211,9 @@ module UnusedOpens = match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some entity when entity.IsNamespace || entity.IsFSharpModule || entity.IsOpenableType -> + // Show namespaces, modules, openable types, and type abbreviations. + // We show type abbreviations because they may have nested types that could be accessed. + | Some entity when entity.IsNamespace || entity.IsFSharpModule || entity.IsOpenableType || entity.IsFSharpAbbreviation -> symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.RangeAlternate) | _ -> () | _ -> () diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index cd1a1a83d81..cf0f8b04043 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -533,7 +533,7 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = isResolvedAndFSharp() && entity.IsUnionTycon member __.IsOpenableType = - isResolved() && isOpenableTycon entity.Deref + isResolved() && isOpenableTyconRef entity member __.HasAssemblyCodeRepresentation = isResolvedAndFSharp() && (entity.IsAsmReprTycon || entity.IsMeasureableReprTycon) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index d33030104d9..3c1556caafb 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -219,7 +219,6 @@ namespace CSharpTest """ namespace FSharpTest -open System open type CSharpTest.Test module Test = @@ -238,6 +237,98 @@ module Test = CompilerAssert.Compile(fsCmpl) + [] + let ``Open a type where the type declaration uses a type abbreviation as a qualifier to a real nested type`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public void A() + { + } + } + + public class NestedTest + { + public void B() + { + } + } + } +} + """ + + let fsharpSource = + """ +namespace FSharpTest + +open System +type Abbrev = CSharpTest.Test +open type Abbrev.NestedTest + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) + + CompilerAssert.Compile(fsCmpl) + + [] + let ``Open a type where the type declaration uses a type abbreviation - Error`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public void A() + { + } + } + + public class NestedTest + { + public void B() + { + } + } + } +} + """ + + let fsharpSource = + """ +namespace FSharpTest + +open System +type Abbrev = CSharpTest.Test +open type Abbrev + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) + + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 39, (6, 11, 6, 17), "The type 'Abbrev' is not defined.") + |]) + [] let ``Open a nested type as qualified`` () = let csharpSource = From e7bebce2240aa0fb3cc2e4a9ce2f441f42f3465b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Jun 2020 18:43:38 +0100 Subject: [PATCH 09/89] open static prototype --- src/fsharp/CompileOps.fs | 8 +- src/fsharp/NameResolution.fs | 45 +++++++---- src/fsharp/NameResolution.fsi | 12 ++- src/fsharp/SyntaxTree.fs | 10 ++- src/fsharp/TypeChecker.fs | 93 +++++++++++++--------- src/fsharp/TypeChecker.fsi | 2 +- src/fsharp/fsi/fsi.fsproj | 2 +- src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj | 2 +- src/fsharp/service/FSharpCheckerResults.fs | 5 +- src/fsharp/symbols/Symbols.fs | 21 ++++- src/fsharp/symbols/Symbols.fsi | 12 ++- tests/service/InteractiveCheckerTests.fs | 2 +- 12 files changed, 140 insertions(+), 74 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index f44e3f1aed0..0272d1204a7 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -5580,7 +5580,7 @@ let GetInitialTcEnv (thisAssemblyName: string, initm: range, tcConfig: TcConfig, let tcEnv = CreateInitialTcEnv(tcGlobals, amap, initm, thisAssemblyName, ccus) if tcConfig.checkOverflow then - try TcOpenDecl TcResultsSink.NoSink tcGlobals amap initm initm tcEnv (pathToSynLid initm (splitNamespace FSharpLib.CoreOperatorsCheckedName)) + try TcOpenModuleOrNamespaceDecl TcResultsSink.NoSink tcGlobals amap initm initm tcEnv (pathToSynLid initm (splitNamespace FSharpLib.CoreOperatorsCheckedName)) with e -> errorRecovery e initm; tcEnv else tcEnv @@ -5737,7 +5737,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: | None -> tcEnv | Some prefixPath -> let m = qualNameOfFile.Range - TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath + TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m m tcEnv prefixPath let tcState = { tcState with @@ -5785,13 +5785,13 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: // Open the prefixPath for fsi.exe (tcImplEnv) let tcImplEnv = match prefixPathOpt with - | Some prefixPath -> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath + | Some prefixPath -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m m tcImplEnv prefixPath | _ -> tcImplEnv // Open the prefixPath for fsi.exe (tcSigEnv) let tcSigEnv = match prefixPathOpt with - | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath + | Some prefixPath when not hadSig -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m m tcSigEnv prefixPath | _ -> tcSigEnv let ccuSig = CombineCcuContentFragments m [implFileSigType; tcState.tcsCcuSig ] diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 43d7d1e6f19..2a276ebf877 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -770,10 +770,9 @@ let AddUnionCases2 bulkAddMode (eUnqualifiedItems: UnqualifiedItems) (ucrefs: Un let item = Item.UnionCase(GeneralizeUnionCaseRef ucref, false) acc.Add (ucref.CaseName, item)) -let AddStaticContentOfTyconRefToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (tcref:TyconRef) = +let AddStaticContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = // If OpenStaticClasses is not enabled then don't do this if amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses then - let ty = generalizedTyconRef tcref let infoReader = InfoReader(g,amap) let items = [| let methGroups = @@ -881,10 +880,13 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) eUnindexedExtensionMembers = eUnindexedExtensionMembers } let nenv = - if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && isStaticClass g tcref then - AddStaticContentOfTyconRefToNameEnv g amap ad m nenv tcref + if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true + && amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses then + if tcref.Typars(m).Length > 0 then failwith "nope" // TODO proper error + let ty = generalizedTyconRef tcref + AddStaticContentOfTypeToNameEnv g amap ad m nenv ty else - nenv + nenv nenv @@ -1011,11 +1013,14 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai and AddEntitiesContentsToNameEnv g amap ad m root nenv modrefs = (modrefs, nenv) ||> List.foldBack (fun modref acc -> AddEntityContentsToNameEnv g amap ad m root acc modref) +and AddTypeStaticContentsToNameEnv g amap ad m nenv (typ: TType) = + assert (isAppTy g typ) + assert not (tcrefOfAppTy g typ).IsModuleOrNamespace + AddStaticContentOfTypeToNameEnv g amap ad m nenv typ + and AddEntityContentsToNameEnv g amap ad m root nenv (modref: EntityRef) = - if modref.IsModuleOrNamespace then - AddModuleOrNamespaceContentsToNameEnv g amap ad m root nenv modref - else - AddStaticContentOfTyconRefToNameEnv g amap ad m nenv modref + assert modref.IsModuleOrNamespace + AddModuleOrNamespaceContentsToNameEnv g amap ad m root nenv modref /// Add a single modules or namespace to the name resolution environment let AddModuleOrNamespaceRefToNameEnv g amap m root ad nenv (modref: EntityRef) = @@ -1423,20 +1428,26 @@ type ItemOccurence = | Open type OpenDeclaration = - { LongId: Ident list + { Target: SynOpenDeclTarget Range: range option Modules: ModuleOrNamespaceRef list + Types: TType list AppliedScope: range IsOwnNamespace: bool } - static member Create(longId: Ident list, modules: ModuleOrNamespaceRef list, appliedScope: range, isOwnNamespace: bool) = - { LongId = longId + static member Create(target: SynOpenDeclTarget, modules: ModuleOrNamespaceRef list, types: TType list, appliedScope: range, isOwnNamespace: bool) = + { Target = target Range = - match longId with - | [] -> None - | first :: rest -> - let last = rest |> List.tryLast |> Option.defaultValue first - Some (mkRange appliedScope.FileName first.idRange.Start last.idRange.End) + match target with + | SynOpenDeclTarget.OpenModuleOrNamespace(longId) -> + match longId with + | [] -> None + | first :: rest -> + let last = rest |> List.tryLast |> Option.defaultValue first + Some (mkRange appliedScope.FileName first.idRange.Start last.idRange.End) + | SynOpenDeclTarget.OpenType(synType) -> + Some synType.Range + Types = types Modules = modules AppliedScope = appliedScope IsOwnNamespace = isOwnNamespace } diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 685871c056a..259347b703b 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -244,6 +244,9 @@ val internal AddModuleOrNamespaceRefToNameEnv : TcGlobals -> /// Add a list of modules or namespaces to the name resolution environment val internal AddEntitiesContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> ModuleOrNamespaceRef list -> NameResolutionEnv +/// Add the static content of a type to the name resolution environment +val internal AddTypeStaticContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> NameResolutionEnv -> TType -> NameResolutionEnv + /// A flag which indicates if it is an error to have two declared type parameters with identical names /// in the name resolution environment. type CheckForDuplicateTyparFlag = @@ -373,8 +376,8 @@ type internal TcSymbolUses = /// Represents open declaration statement. type internal OpenDeclaration = - { /// Long identifier as it's presented in source code. - LongId: Ident list + { /// Syntax after 'open' as it's presented in source code. + Target: SynOpenDeclTarget /// Full range of the open declaration. Range : range option @@ -382,6 +385,9 @@ type internal OpenDeclaration = /// Modules or namespaces which is opened with this declaration. Modules: ModuleOrNamespaceRef list + /// Types whose static content is opened with this declaration. + Types: TType list + /// Scope in which open declaration is visible. AppliedScope: range @@ -389,7 +395,7 @@ type internal OpenDeclaration = IsOwnNamespace: bool } /// Create a new instance of OpenDeclaration. - static member Create : longId: Ident list * modules: ModuleOrNamespaceRef list * appliedScope: range * isOwnNamespace: bool -> OpenDeclaration + static member Create : target: SynOpenDeclTarget * modules: ModuleOrNamespaceRef list * types: TType list * appliedScope: range * isOwnNamespace: bool -> OpenDeclaration /// Source text and an array of line end positions, used for format string parsing type FormatStringCheckContext = diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs index 94fd921eaff..e76dcffeb93 100644 --- a/src/fsharp/SyntaxTree.fs +++ b/src/fsharp/SyntaxTree.fs @@ -1856,7 +1856,7 @@ type SynMemberDefn = /// An 'open' definition within a type | Open of - longId: LongIdent * + target: SynOpenDeclTarget * range: range /// A 'member' definition within a type @@ -1988,7 +1988,7 @@ type SynModuleDecl = /// An 'open' definition within a module | Open of - longDotId: LongIdentWithDots * + target: SynOpenDeclTarget * range: range /// An attribute definition within a module, for assembly and .NET module attributes @@ -2019,6 +2019,10 @@ type SynModuleDecl = | SynModuleDecl.NamespaceFragment (SynModuleOrNamespace (range=m)) | SynModuleDecl.Attributes (range=m) -> m +type SynOpenDeclTarget = + | OpenModuleOrNamespace of Ident list + | OpenType of SynType + /// Represents the right hand side of an exception definition in a signature file [] type SynExceptionSig = @@ -2061,7 +2065,7 @@ type SynModuleSigDecl = /// An 'open' definition within a module or namespace in a signature file | Open of - longId: LongIdent * + target: SynOpenDeclTarget * range: range /// A hash directive within a module or namespace in a signature file diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index d3f67c28ae7..58379130e70 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -383,6 +383,14 @@ let OpenEntities tcSink g amap scopem root env mvvs openDeclaration = CallOpenDeclarationSink tcSink openDeclaration env +/// Adjust the TcEnv to account for opening the set of modules, namespaces or static classes implied by an `open` declaration +let OpenTypeStaticContent tcSink g amap scopem env (typ: TType) openDeclaration = + let env = + { env with eNameResEnv = AddTypeStaticContentsToNameEnv g amap env.eAccessRights scopem env.eNameResEnv typ } + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) + CallOpenDeclarationSink tcSink openDeclaration + env + /// Adjust the TcEnv to account for a new root Ccu being available, e.g. a referenced assembly let AddRootModuleOrNamespaceRefs g amap m env modrefs = if isNil modrefs then env else @@ -651,7 +659,8 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = match ResolveLongIndentAsModuleOrNamespaceOrStaticClass tcSink ResultCollectionSettings.AllResults amap scopem true true OpenQualified env.eNameResEnv ad id rest true with | Result modrefs -> let modrefs = List.map p23 modrefs - let openDecl = OpenDeclaration.Create (enclosingNamespacePathToOpen, modrefs, scopem, true) + let openTarget = SynOpenDeclTarget.OpenModuleOrNamespace(enclosingNamespacePathToOpen) + let openDecl = OpenDeclaration.Create (openTarget, modrefs, [], scopem, true) OpenEntities tcSink g amap scopem false env modrefs openDecl | Exception _ -> env | _ -> env @@ -3626,16 +3635,20 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = // Mutually recursive shapes //------------------------------------------------------------------------- +type MutRecDataForOpen = MutRecDataForOpen of SynOpenDeclTarget * range * appliedScope: range +type MutRecDataForOpenType = MutRecDataForOpenType of SynType * range * appliedScope: range +type MutRecDataForModuleAbbrev = MutRecDataForModuleAbbrev of Ident * LongIdent * range + /// Represents the shape of a mutually recursive group of declarations including nested modules [] -type MutRecShape<'TypeData, 'LetsData, 'ModuleData, 'ModuleAbbrevData, 'OpenData> = +type MutRecShape<'TypeData, 'LetsData, 'ModuleData> = | Tycon of 'TypeData | Lets of 'LetsData - | Module of 'ModuleData * MutRecShapes<'TypeData, 'LetsData, 'ModuleData, 'ModuleAbbrevData, 'OpenData> - | ModuleAbbrev of 'ModuleAbbrevData - | Open of 'OpenData + | Module of 'ModuleData * MutRecShapes<'TypeData, 'LetsData, 'ModuleData> + | ModuleAbbrev of MutRecDataForModuleAbbrev + | Open of MutRecDataForOpen -and MutRecShapes<'TypeData, 'LetsData, 'ModuleData, 'ModuleAbbrevData, 'OpenData> = MutRecShape<'TypeData, 'LetsData, 'ModuleData, 'ModuleAbbrevData, 'OpenData> list +and MutRecShapes<'TypeData, 'LetsData, 'ModuleData> = MutRecShape<'TypeData, 'LetsData, 'ModuleData> list module MutRecShapes = let rec map f1 f2 f3 x = @@ -3772,7 +3785,7 @@ let EliminateInitializationGraphs (getLetBinds: 'LetDataIn list -> PreInitializationGraphEliminationBinding list) (morphLetBinds: (PreInitializationGraphEliminationBinding list -> Binding list) -> 'LetDataIn list -> Binding list) g mustHaveArity denv - (fixupsAndBindingsWithoutLaziness: MutRecShape<_, _, _, _, _> list) bindsm = + (fixupsAndBindingsWithoutLaziness: MutRecShape<_, _, _> list) bindsm = let recursiveVals = let hash = ValHash.Create() @@ -4231,21 +4244,18 @@ type ValSpecResult = ValSpecResult of ParentRef * ValMemberInfoTransient option type RecDefnBindingInfo = RecDefnBindingInfo of ContainerInfo * NewSlotsOK * DeclKind * SynBinding -type MutRecDataForOpen = MutRecDataForOpen of LongIdent * range * appliedScope: range -type MutRecDataForModuleAbbrev = MutRecDataForModuleAbbrev of Ident * LongIdent * range - -type MutRecSigsInitialData = MutRecShape list -type MutRecDefnsInitialData = MutRecShape list +type MutRecSigsInitialData = MutRecShape list +type MutRecDefnsInitialData = MutRecShape list type MutRecDefnsPhase1DataForTycon = MutRecDefnsPhase1DataForTycon of SynComponentInfo * SynTypeDefnSimpleRepr * (SynType * range) list * preEstablishedHasDefaultCtor: bool * hasSelfReferentialCtor: bool * isAtOriginalTyconDefn: bool -type MutRecDefnsPhase1Data = MutRecShape list +type MutRecDefnsPhase1Data = MutRecShape list type MutRecDefnsPhase2DataForTycon = MutRecDefnsPhase2DataForTycon of Tycon option * ParentRef * DeclKind * TyconRef * Val option * SafeInitData * Typars * SynMemberDefn list * range * NewSlotsOK * fixupFinalAttribs: (unit -> unit) type MutRecDefnsPhase2DataForModule = MutRecDefnsPhase2DataForModule of ModuleOrNamespaceType ref * ModuleOrNamespace -type MutRecDefnsPhase2Data = MutRecShape list +type MutRecDefnsPhase2Data = MutRecShape list type MutRecDefnsPhase2InfoForTycon = MutRecDefnsPhase2InfoForTycon of Tycon option * TyconRef * Typars * DeclKind * TyconBindingDefn list * fixupFinalAttrs: (unit -> unit) -type MutRecDefnsPhase2Info = MutRecShape list +type MutRecDefnsPhase2Info = MutRecShape list /// RecursiveBindingInfo - flows through initial steps of TcLetrec @@ -12946,7 +12956,7 @@ let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) = | Exception err -> errorR(err); [] -let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = +let TcOpenModuleOrNamespaceDecl tcSink g amap m scopem env (longId: Ident list) = match TcOpenLidAndPermitAutoResolve tcSink env amap longId with | [] -> env | modrefs -> @@ -12998,11 +13008,21 @@ let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = let modrefs = List.map p23 modrefs modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult) - let openDecl = OpenDeclaration.Create (longId, modrefs, scopem, false) + let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.OpenModuleOrNamespace longId, modrefs, [], scopem, false) let env = OpenEntities tcSink g amap scopem false env modrefs openDecl env +let TcOpenTypeDecl (cenv: cenv) scopem env (synType: SynType) = + let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType + let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.OpenType synType, [], [typ], scopem, false) + let env = OpenTypeStaticContent cenv.tcSink cenv.g cenv.amap scopem env typ openDecl + env +let TcOpenDecl cenv m scopem env (content: SynOpenDeclTarget) = + match content with + | SynOpenDeclTarget.OpenModuleOrNamespace (longId) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m scopem env longId + | SynOpenDeclTarget.OpenType synType -> TcOpenTypeDecl cenv scopem env synType + exception ParameterlessStructCtor of range /// Incremental class definitions @@ -13849,7 +13869,7 @@ module MutRecBindingChecking = | TyconBindingsPhase2A of Tycon option * DeclKind * Val list * TyconRef * Typar list * TType * TyconBindingPhase2A list /// The collected syntactic input definitions for a recursive group of type or type-extension definitions - type MutRecDefnsPhase2AData = MutRecShape list + type MutRecDefnsPhase2AData = MutRecShape list /// Represents one element in a type definition, after the second phase type TyconBindingPhase2B = @@ -13868,7 +13888,7 @@ module MutRecBindingChecking = type TyconBindingsPhase2B = TyconBindingsPhase2B of Tycon option * TyconRef * TyconBindingPhase2B list - type MutRecDefnsPhase2BData = MutRecShape list + type MutRecDefnsPhase2BData = MutRecShape list /// Represents one element in a type definition, after the third phase type TyconBindingPhase2C = @@ -13882,7 +13902,7 @@ module MutRecBindingChecking = type TyconBindingsPhase2C = TyconBindingsPhase2C of Tycon option * TyconRef * TyconBindingPhase2C list - type MutRecDefnsPhase2CData = MutRecShape list + type MutRecDefnsPhase2CData = MutRecShape list @@ -14234,8 +14254,8 @@ module MutRecBindingChecking = #if OPEN_IN_TYPE_DECLARATIONS | Phase2AOpen(mp, m) -> - let envInstance = TcOpenDecl cenv.tcSink g cenv.amap m scopem envInstance mp - let envStatic = TcOpenDecl cenv.tcSink g cenv.amap m scopem envStatic mp + let envInstance = TcOpenDecl cenv m scopem envInstance mp + let envStatic = TcOpenDecl cenv m scopem envStatic mp let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BOpen, innerState #endif @@ -14542,7 +14562,7 @@ module MutRecBindingChecking = // Add the modules being defined let envForDecls = (envForDecls, mspecs) ||> List.fold ((if report then AddLocalSubModuleAndReport cenv.tcSink scopem else AddLocalSubModule) cenv.g cenv.amap m) // Process the 'open' declarations - let envForDecls = (envForDecls, opens) ||> List.fold (fun env (mp, m, moduleRange) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m moduleRange env mp) + let envForDecls = (envForDecls, opens) ||> List.fold (fun env (target, m, moduleRange) -> TcOpenDecl cenv m moduleRange env target) // Add the type definitions being defined let envForDecls = (if report then AddLocalTyconsAndReport cenv.tcSink scopem else AddLocalTycons) cenv.g cenv.amap m tycons envForDecls // Add the exception definitions being defined @@ -15462,7 +15482,7 @@ module EstablishTypeDefinitionCores = let AdjustModuleName modKind nm = (match modKind with FSharpModuleWithSuffix -> nm+FSharpModuleSuffix | _ -> nm) - let TypeNamesInMutRecDecls cenv env (compDecls: MutRecShapes) = + let TypeNamesInMutRecDecls cenv env (compDecls: MutRecShapes) = [ for d in compDecls do match d with | MutRecShape.Tycon (MutRecDefnsPhase1DataForTycon(ComponentInfo(_, typars, _, ids, _, _, _, _), _, _, _, _, isAtOriginalTyconDefn), _) -> @@ -15934,7 +15954,7 @@ module EstablishTypeDefinitionCores = // Third phase: check and publish the super types. Run twice, once before constraints are established // and once after - let private TcTyconDefnCore_Phase1D_Phase1F_EstablishSuperTypesAndInterfaceTypes cenv tpenv inSig pass (envMutRec, mutRecDefns: MutRecShape<(_ * (Tycon * (Attribs * _)) option), _, _, _, _> list) = + let private TcTyconDefnCore_Phase1D_Phase1F_EstablishSuperTypesAndInterfaceTypes cenv tpenv inSig pass (envMutRec, mutRecDefns: MutRecShape<(_ * (Tycon * (Attribs * _)) option), _, _> list) = let checkCxs = if (pass = SecondPass) then CheckCxs else NoCheckCxs let firstPass = (pass = FirstPass) @@ -16611,7 +16631,7 @@ module EstablishTypeDefinitionCores = | _ -> ()) - let TcMutRecDefns_Phase1 mkLetInfo cenv envInitial parent typeNames inSig tpenv m scopem mutRecNSInfo (mutRecDefns: MutRecShapes) = + let TcMutRecDefns_Phase1 mkLetInfo cenv envInitial parent typeNames inSig tpenv m scopem mutRecNSInfo (mutRecDefns: MutRecShapes) = let g = cenv.g // Phase1A - build Entity for type definitions, exception definitions and module definitions. // Also for abbreviations of any of these. Augmentations are skipped in this phase. @@ -17299,9 +17319,9 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS let env = TcDeclarations.TcMutRecSignatureDecls cenv env parent typeNames emptyUnscopedTyparEnv m scopem None mutRecDefns return env - | SynModuleSigDecl.Open (mp, m) -> + | SynModuleSigDecl.Open (target, m) -> let scopem = unionRanges m.EndRange endm - let env = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp + let env = TcOpenDecl cenv m scopem env target return env | SynModuleSigDecl.Val (vspec, m) -> @@ -17419,7 +17439,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment. let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] | None -> env // Publish the combined module type @@ -17531,7 +17551,7 @@ let ElimModuleDoBinding bind = SynModuleDecl.Let(false, [bind2], m) | _ -> bind -let TcMutRecDefnsEscapeCheck (binds: MutRecShapes<_, _, _, _, _>) env = +let TcMutRecDefnsEscapeCheck (binds: MutRecShapes<_, _, _>) env = let freeInEnv = GeneralizationHelpers.ComputeUnabstractableTycons env let checkTycon (tycon: Tycon) = if not tycon.IsTypeAbbrev && Zset.contains tycon freeInEnv then @@ -17593,9 +17613,9 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem return (exprfWithEscapeCheck, []), envAfter, envAfter - | SynModuleDecl.Open (LongIdentWithDots(mp, _), m) -> + | SynModuleDecl.Open (target, m) -> let scopem = unionRanges m.EndRange scopem - let env = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp + let env = TcOpenDecl cenv m scopem env target return ((fun e -> e), []), env, env | SynModuleDecl.Let (letrec, binds, m) -> @@ -17728,7 +17748,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] | None -> env // Publish the combined module type @@ -17795,9 +17815,9 @@ and TcModuleOrNamespaceElementsMutRec cenv parent typeNames m envInitial mutRecN let decls = [MutRecShape.Module (compInfo, mutRecDefs)] decls, (false, false, attrs) - | SynModuleDecl.Open (LongIdentWithDots(lid, _), m) -> + | SynModuleDecl.Open (target, m) -> if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) - let decls = [ MutRecShape.Open (MutRecDataForOpen(lid, m, moduleRange)) ] + let decls = [ MutRecShape.Open (MutRecDataForOpen(target, m, moduleRange)) ] decls, (openOk, moduleAbbrevOk, attrs) | SynModuleDecl.Exception (SynExceptionDefn(repr, members, _), _m) -> @@ -17900,7 +17920,8 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env match modref.TryDeref with | ValueNone -> warn() | ValueSome _ -> - let openDecl = OpenDeclaration.Create ([], [modref], scopem, false) + let openTarget = SynOpenDeclTarget.OpenModuleOrNamespace([]) + let openDecl = OpenDeclaration.Create (openTarget, [modref], [], scopem, false) OpenEntities TcResultsSink.NoSink g amap scopem root env [modref] openDecl // Add the CCU and apply the "AutoOpen" attributes diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index 49471c97d7e..f9ba68911be 100644 --- a/src/fsharp/TypeChecker.fsi +++ b/src/fsharp/TypeChecker.fsi @@ -26,7 +26,7 @@ val AddCcuToTcEnv : TcGlobals * ImportMap * range * TcEnv * assemblyName: s val AddLocalRootModuleOrNamespace : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> TcEnv -> ModuleOrNamespaceType -> TcEnv val AddLocalVal : NameResolution.TcResultsSink -> scopem: range -> v: Val -> TcEnv -> TcEnv val AddLocalSubModule : TcGlobals -> ImportMap -> range -> TcEnv -> ModuleOrNamespace -> TcEnv -val TcOpenDecl : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> range -> TcEnv -> LongIdent -> TcEnv +val TcOpenModuleOrNamespaceDecl: NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> range -> TcEnv -> LongIdent -> TcEnv type TopAttribs = { mainMethodAttrs : Attribs; diff --git a/src/fsharp/fsi/fsi.fsproj b/src/fsharp/fsi/fsi.fsproj index 32591e18d2e..c28e975ff69 100644 --- a/src/fsharp/fsi/fsi.fsproj +++ b/src/fsharp/fsi/fsi.fsproj @@ -17,7 +17,7 @@ x86 - $(DefineConstants);FSI_SHADOW_COPY_REFERENCES;FSI_SERVER + $(DefineConstants);FSI_SERVER diff --git a/src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj b/src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj index d39051b414c..b73c60db2ef 100644 --- a/src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj +++ b/src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj @@ -16,7 +16,7 @@ - $(DefineConstants);FSI_SHADOW_COPY_REFERENCES;FSI_SERVER + $(DefineConstants);FSI_SERVER diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 31263f4e282..9afcc795b1a 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -1913,7 +1913,10 @@ type FSharpCheckFileResults scopeOptX |> Option.map (fun scope -> let cenv = scope.SymbolEnv - scope.OpenDeclarations |> Array.map (fun x -> FSharpOpenDeclaration(x.LongId, x.Range, (x.Modules |> List.map (fun x -> FSharpEntity(cenv, x))), x.AppliedScope, x.IsOwnNamespace))) + scope.OpenDeclarations |> Array.map (fun x -> + let modules = x.Modules |> List.map (fun x -> FSharpEntity(cenv, x)) + let types = x.Types |> List.map (fun x -> FSharpType(cenv, x)) + FSharpOpenDeclaration(x.Target, x.Range, modules, types, x.AppliedScope, x.IsOwnNamespace))) |> Option.defaultValue [| |] override __.ToString() = "FSharpCheckFileResults(" + filename + ")" diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index f387a9bc7e1..b0631e833c9 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -2499,12 +2499,27 @@ and FSharpAssembly internal (cenv, ccu: CcuThunk) = /// Represents open declaration in F# code. [] -type FSharpOpenDeclaration(longId: Ident list, range: range option, modules: FSharpEntity list, appliedScope: range, isOwnNamespace: bool) = - - member __.LongId = longId +type FSharpOpenDeclaration(target: SynOpenDeclTarget, range: range option, modules: FSharpEntity list, types: FSharpType list, appliedScope: range, isOwnNamespace: bool) = + + member __.Target= target + + member __.LongId = + match target with + | SynOpenDeclTarget.OpenModuleOrNamespace(longId) -> longId + | SynOpenDeclTarget.OpenType(synType) -> + let rec get ty = + match ty with + | SynType.LongIdent (LongIdentWithDots(lid, _)) -> lid + | SynType.App (ty2, _, _, _, _, _, _) -> get ty2 + | SynType.LongIdentApp (ty2, _, _, _, _, _, _) -> get ty2 + | SynType.Paren (ty2, _) -> get ty2 + | _ -> [] + get synType member __.Range = range + member __.Types = types + member __.Modules = modules member __.AppliedScope = appliedScope diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 4f8313c7919..23736fcb832 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -1051,10 +1051,13 @@ and [] public FSharpAttribute = [] type public FSharpOpenDeclaration = - internal new : longId: Ident list * range: range option * modules: FSharpEntity list * appliedScope: range * isOwnNamespace: bool -> FSharpOpenDeclaration + internal new : target: SynOpenDeclTarget * range: range option * modules: FSharpEntity list * types: FSharpType list * appliedScope: range * isOwnNamespace: bool -> FSharpOpenDeclaration - /// Idents. - member LongId: Ident list + /// The syntactic target of the declaration + member LongId: Ident list + + /// The syntactic target of the declaration + member Target: SynOpenDeclTarget /// Range of the open declaration. member Range: range option @@ -1062,6 +1065,9 @@ type public FSharpOpenDeclaration = /// Modules or namespaces which is opened with this declaration. member Modules: FSharpEntity list + /// Types whose static content is opened with this declaration. + member Types: FSharpType list + /// Scope in which open declaration is visible. member AppliedScope: range diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index f03127bb8a7..9b637dddf37 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -42,7 +42,7 @@ let internal identsAndRanges (input: ParsedInput) = | SynModuleDecl.Let(_, _, _) -> failwith "Not implemented yet" | SynModuleDecl.DoExpr(_, _, _range) -> failwith "Not implemented yet" | SynModuleDecl.Exception(_, _range) -> failwith "Not implemented yet" - | SynModuleDecl.Open(longIdentWithDots, range) -> [ identAndRange (longIdentWithDotsToString longIdentWithDots) range ] + | SynModuleDecl.Open(lid, range) -> [ identAndRange (longIdentToString lid) range ] | SynModuleDecl.Attributes(_attrs, _range) -> failwith "Not implemented yet" | SynModuleDecl.HashDirective(_, _range) -> failwith "Not implemented yet" | SynModuleDecl.NamespaceFragment(moduleOrNamespace) -> extractFromModuleOrNamespace moduleOrNamespace From 23a9d3a189030c80d2c4b620ae0ba3871d102c7d Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Jun 2020 18:55:55 +0100 Subject: [PATCH 10/89] open static prototype --- src/fsharp/NameResolution.fs | 4 ++-- src/fsharp/SyntaxTree.fs | 5 +++-- src/fsharp/TypeChecker.fs | 12 ++++++------ src/fsharp/pars.fsy | 19 +++++++++++-------- src/fsharp/symbols/Symbols.fs | 4 ++-- 5 files changed, 24 insertions(+), 20 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 2a276ebf877..c7f8c7de1c1 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1439,13 +1439,13 @@ type OpenDeclaration = { Target = target Range = match target with - | SynOpenDeclTarget.OpenModuleOrNamespace(longId) -> + | SynOpenDeclTarget.ModuleOrNamespace(longId) -> match longId with | [] -> None | first :: rest -> let last = rest |> List.tryLast |> Option.defaultValue first Some (mkRange appliedScope.FileName first.idRange.Start last.idRange.End) - | SynOpenDeclTarget.OpenType(synType) -> + | SynOpenDeclTarget.Type(synType) -> Some synType.Range Types = types Modules = modules diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs index e76dcffeb93..f824885d6fb 100644 --- a/src/fsharp/SyntaxTree.fs +++ b/src/fsharp/SyntaxTree.fs @@ -2019,9 +2019,10 @@ type SynModuleDecl = | SynModuleDecl.NamespaceFragment (SynModuleOrNamespace (range=m)) | SynModuleDecl.Attributes (range=m) -> m +[] type SynOpenDeclTarget = - | OpenModuleOrNamespace of Ident list - | OpenType of SynType + | ModuleOrNamespace of Ident list + | Type of SynType /// Represents the right hand side of an exception definition in a signature file [] diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 58379130e70..12e914fe1f2 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -659,7 +659,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = match ResolveLongIndentAsModuleOrNamespaceOrStaticClass tcSink ResultCollectionSettings.AllResults amap scopem true true OpenQualified env.eNameResEnv ad id rest true with | Result modrefs -> let modrefs = List.map p23 modrefs - let openTarget = SynOpenDeclTarget.OpenModuleOrNamespace(enclosingNamespacePathToOpen) + let openTarget = SynOpenDeclTarget.ModuleOrNamespace(enclosingNamespacePathToOpen) let openDecl = OpenDeclaration.Create (openTarget, modrefs, [], scopem, true) OpenEntities tcSink g amap scopem false env modrefs openDecl | Exception _ -> env @@ -13008,20 +13008,20 @@ let TcOpenModuleOrNamespaceDecl tcSink g amap m scopem env (longId: Ident list) let modrefs = List.map p23 modrefs modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult) - let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.OpenModuleOrNamespace longId, modrefs, [], scopem, false) + let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.ModuleOrNamespace longId, modrefs, [], scopem, false) let env = OpenEntities tcSink g amap scopem false env modrefs openDecl env let TcOpenTypeDecl (cenv: cenv) scopem env (synType: SynType) = let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType - let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.OpenType synType, [], [typ], scopem, false) + let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type synType, [], [typ], scopem, false) let env = OpenTypeStaticContent cenv.tcSink cenv.g cenv.amap scopem env typ openDecl env let TcOpenDecl cenv m scopem env (content: SynOpenDeclTarget) = match content with - | SynOpenDeclTarget.OpenModuleOrNamespace (longId) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m scopem env longId - | SynOpenDeclTarget.OpenType synType -> TcOpenTypeDecl cenv scopem env synType + | SynOpenDeclTarget.ModuleOrNamespace (longId) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m scopem env longId + | SynOpenDeclTarget.Type synType -> TcOpenTypeDecl cenv scopem env synType exception ParameterlessStructCtor of range @@ -17920,7 +17920,7 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env match modref.TryDeref with | ValueNone -> warn() | ValueSome _ -> - let openTarget = SynOpenDeclTarget.OpenModuleOrNamespace([]) + let openTarget = SynOpenDeclTarget.ModuleOrNamespace([]) let openDecl = OpenDeclaration.Create (openTarget, [modref], [], scopem, false) OpenEntities TcResultsSink.NoSink g amap scopem root env [modref] openDecl diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 28d9e9df8d9..0c107a34813 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -288,7 +288,6 @@ let rangeOfLongIdent(lid:LongIdent) = %type exconDefn %type exconCore %type moduleDefnsOrExprPossiblyEmptyOrBlock -%type openDecl %type path %type pathOp /* LESS GREATER parsedOk typeArgs m for each mWhole */ @@ -767,8 +766,8 @@ moduleSpfn: let ec = (SynExceptionSig(SynExceptionDefnRepr($1@cas, a, b, c, d, d2), e, f)) SynModuleSigDecl.Exception(ec, rhs parseState 3) } - | OPEN path - { SynModuleSigDecl.Open ($2.Lid, unionRanges (rhs parseState 1) $2.Range) } + | openDecl + { let a,b = $1 in SynModuleSigDecl.Open (a, b) } valSpfn: | opt_attributes opt_declVisibility VAL opt_attributes opt_inline opt_mutable opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints optLiteralValueSpfn @@ -1261,9 +1260,16 @@ moduleDefn: [] } /* 'open' declarations */ - | openDecl - { [SynModuleDecl.Open($1, $1.Range)] } + | openDecl + { let a,b = $1 in [ SynModuleDecl.Open(a, b)] } +openDecl: + /* 'open' declarations */ + | OPEN path + { SynOpenDeclTarget.ModuleOrNamespace $2.Lid, unionRanges (rhs parseState 1) $2.Range } + + | OPEN TYPE appType + { SynOpenDeclTarget.Type $3, unionRanges (rhs parseState 1) $3.Range } /* The right-hand-side of a module abbreviation definition */ /* This occurs on the right of a module abbreviation (#light encloses the r.h.s. with OBLOCKBEGIN/OBLOCKEND) */ @@ -2461,9 +2467,6 @@ exconRepr: | EQUALS path { Some ($2.Lid) } -openDecl: - | OPEN path { $2 } - /*-------------------------------------------------------------------------*/ /* F# Definitions, Types, Patterns and Expressions */ diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index b0631e833c9..fbc4eb936b7 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -2505,8 +2505,8 @@ type FSharpOpenDeclaration(target: SynOpenDeclTarget, range: range option, modul member __.LongId = match target with - | SynOpenDeclTarget.OpenModuleOrNamespace(longId) -> longId - | SynOpenDeclTarget.OpenType(synType) -> + | SynOpenDeclTarget.ModuleOrNamespace(longId) -> longId + | SynOpenDeclTarget.Type(synType) -> let rec get ty = match ty with | SynType.LongIdent (LongIdentWithDots(lid, _)) -> lid From 5feed0aba5703f7d949301475142249ebe55c523 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 24 Jun 2020 15:37:52 -0700 Subject: [PATCH 11/89] Fixes on merge --- src/fsharp/NameResolution.fs | 117 +++++-------------- src/fsharp/NameResolution.fsi | 3 - src/fsharp/TypeChecker.fs | 19 +-- src/fsharp/TypedTreeOps.fs | 24 ---- src/fsharp/TypedTreeOps.fsi | 2 - src/fsharp/pars.fsy | 13 +-- src/fsharp/service/FSharpCheckerResults.fs | 10 +- src/fsharp/service/ServiceAnalysis.fs | 12 +- src/fsharp/service/ServiceAssemblyContent.fs | 4 +- src/fsharp/service/ServiceParseTreeWalk.fs | 4 +- src/fsharp/service/ServiceStructure.fs | 6 +- src/fsharp/service/ServiceUntypedParse.fs | 8 +- src/fsharp/symbols/Symbols.fs | 3 - src/fsharp/symbols/Symbols.fsi | 3 - 14 files changed, 65 insertions(+), 163 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index eba68a6454a..d1365355d78 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1159,8 +1159,8 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) eUnindexedExtensionMembers = eUnindexedExtensionMembers } let nenv = - if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true - && amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses then + if amap.g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && + TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true then if tcref.Typars(m).Length > 0 then failwith "nope" // TODO proper error let ty = generalizedTyconRef tcref AddStaticContentOfTypeToNameEnv g amap ad m nenv ty @@ -2130,7 +2130,7 @@ let CanLookupModuleOrNamespace (rest: Ident list) isType = not isType || (isType && not rest.IsEmpty) /// Perform name resolution for an identifier which must resolve to be a module or namespace. -let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl isType = +let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl = let g = amap.g if first && id.idText = MangledGlobalName then @@ -2138,7 +2138,7 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection | [] -> error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) | id2 :: rest2 -> - ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl isType + ResolveLongIdentAsModuleOrNamespace sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl else let notFoundAux (id: Ident) depth error (tcrefs: TyconRef seq) = let suggestNames (addToBuffer: string -> unit) = @@ -2152,18 +2152,10 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified let namespaceNotFound = lazy - if isType then - seq { for kv in nenv.TyconsByDemangledNameAndArity fullyQualified do - match kv.Key with - // We choose arity 0 as F# does not support opening parameterized types. - | NameArityPair(_, 0) -> kv.Value - | _ -> () } - |> notFoundAux id 0 FSComp.SR.undefinedNameType - else - seq { for kv in moduleOrNamespaces do - for modref in kv.Value do - modref } - |> notFoundAux id 0 FSComp.SR.undefinedNameNamespaceOrModule + seq { for kv in moduleOrNamespaces do + for modref in kv.Value do + modref } + |> notFoundAux id 0 FSComp.SR.undefinedNameNamespaceOrModule // Avoid generating the same error and name suggestion thunk twice It's not clear this is necessary // since it's just saving an allocation. @@ -2173,83 +2165,44 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection | Some (oldId, error) when Range.equals oldId id.idRange -> error | _ -> let error = - if isType then - seq { for kv in mty.TypesByDemangledNameAndArity m do - match kv.Key with - | NameArityPair(_, 0) -> modref.NestedTyconRef kv.Value - | _ -> () } - |> notFoundAux id depth FSComp.SR.undefinedNameType - else - seq { for kv in mty.ModulesAndNamespacesByDemangledName do - modref.NestedTyconRef kv.Value } - |> notFoundAux id depth FSComp.SR.undefinedNameNamespace + seq { for kv in mty.ModulesAndNamespacesByDemangledName do + modref.NestedTyconRef kv.Value } + |> notFoundAux id depth FSComp.SR.undefinedNameNamespace let error = raze error moduleNotFoundErrorCache <- Some(id.idRange, error) error - let notifyNameResolution nm (modref: ModuleOrNamespaceRef) m = - let item = - if isType && not modref.IsModuleOrNamespace then - // F# does not support opening parameterized types. - Item.Types (nm, [generalizedTyconRef modref]) - else - Item.ModuleOrNamespaces [modref] + let notifyNameResolution (modref: ModuleOrNamespaceRef) m = + let item = Item.ModuleOrNamespaces [modref] let occurence = if isOpenDecl then ItemOccurence.Open else ItemOccurence.Use CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occurence, ad) - let erefs = - let modrefs = - if CanLookupModuleOrNamespace rest isType then - match moduleOrNamespaces.TryGetValue id.idText with - | true, modrefs -> modrefs - | _ -> [] - else - [] - - let tcrefs = - if isType then - LookupTypeNameInEnvNoArity fullyQualified id.idText nenv - else - [] - - modrefs @ tcrefs + let modrefs = + match moduleOrNamespaces.TryGetValue id.idText with + | true, modrefs -> modrefs + | _ -> [] - if not erefs.IsEmpty then + if not modrefs.IsEmpty then /// Look through the sub-namespaces and/or modules let rec look depth (modref: ModuleOrNamespaceRef) (lid: Ident list) = let modref = if not lid.IsEmpty then ResolveNestedTypeThroughAbbreviation g modref m else modref let mty = modref.ModuleOrNamespaceType match lid with | [] -> - if isType && not (isOpenableTyconRef modref) then - moduleNotFound modref mty id depth - else - success [ (depth, modref, mty) ] + success [ (depth, modref, mty) ] | id :: rest -> - let especs = - let modrefs = - if CanLookupModuleOrNamespace rest isType then - match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with - | true, res -> [res] - | _ -> [] - else - [] - - let tcrefs = - if isType then - LookupTypeNameInEntityNoArity id.idRange id.idText mty - else - [] - - modrefs @ tcrefs + let modrefs = + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, res -> [res] + | _ -> [] - if not especs.IsEmpty then - especs + if not modrefs.IsEmpty then + modrefs |> List.map (fun espec -> let subref = modref.NestedTyconRef espec if IsEntityAccessible amap m ad subref then - notifyNameResolution id.idText subref id.idRange + notifyNameResolution subref id.idRange look (depth+1) subref rest else moduleNotFound modref mty id depth) @@ -2257,21 +2210,17 @@ let rec ResolveLongIdentAsModuleOrNamespaceAux sink (atMostOne: ResultCollection else moduleNotFound modref mty id depth - erefs - |> List.map (fun eref -> - if IsEntityAccessible amap m ad eref then - notifyNameResolution id.idText eref id.idRange - look 1 eref rest + modrefs + |> List.map (fun modref -> + if IsEntityAccessible amap m ad modref then + notifyNameResolution modref id.idRange + look 1 modref rest else raze (namespaceNotFound.Force())) |> List.reduce AddResults else raze (namespaceNotFound.Force()) -/// Perform name resolution for an identifier which must resolve to be a module or namespace. -let ResolveLongIdentAsModuleOrNamespace sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl = - ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl false - // 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 ResultCollectionSettings.AllResults amap m true fullyQualified nenv ad id [] isOpenDecl with @@ -2285,10 +2234,6 @@ let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified f resInfo (depth+1) id.idRange modref mty id2 rest2) | Exception err -> Exception err -/// Perform name resolution for an identifier which must resolve to be a type to be used like a module or namespace. -let ResolveTypeLongIdentAsModuleOrNamespace sink atMostOne (amap: Import.ImportMap) m first fullyQualified nenv ad id rest isOpenDecl = - ResolveLongIdentAsModuleOrNamespaceAux sink atMostOne amap m first fullyQualified nenv ad id rest isOpenDecl true - //------------------------------------------------------------------------- // Bind name used in "new Foo.Bar(...)" constructs //------------------------------------------------------------------------- diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 528820911c1..6b91265ce5f 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -532,9 +532,6 @@ type PermitDirectReferenceToGeneratedType = /// Resolve a long identifier to a namespace, module. val internal ResolveLongIdentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > -/// Resolve a long identifier to a type to be used like a namespace, module. -val internal ResolveTypeLongIdentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > - /// Resolve a long identifier to an object constructor. val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index effcc0d8d1a..b72000fae9d 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -12945,14 +12945,13 @@ let TcTyconMemberSpecs cenv env containerInfo declKind tpenv augSpfn = // Bind 'open' declarations //------------------------------------------------------------------------- -let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) isOpenType = +let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) = let ad = env.eAccessRights match longId with | [] -> [] | id :: rest -> let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges - let resOrEx = ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.eNameResEnv ad id rest true - match resOrEx with + match ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.eNameResEnv ad id rest true with | Result res -> res | Exception err -> errorR(err); [] @@ -13013,18 +13012,20 @@ let TcOpenModuleOrNamespaceDecl tcSink g amap m scopem env (longId: Ident list) let env = OpenEntities tcSink g amap scopem false env modrefs openDecl env -let TcOpenTypeDecl (cenv: cenv) scopem env (synType: SynType) = +let TcOpenTypeDecl (cenv: cenv) m scopem env (synType: SynType) = + let g = cenv.g + checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration m let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type synType, [], [typ], scopem, false) - let env = OpenTypeStaticContent cenv.tcSink cenv.g cenv.amap scopem env typ openDecl + let env = OpenTypeStaticContent cenv.tcSink g cenv.amap scopem env typ openDecl env let TcOpenDecl cenv m scopem env (content: SynOpenDeclTarget) = match content with | SynOpenDeclTarget.ModuleOrNamespace (longId) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m scopem env longId - | SynOpenDeclTarget.Type synType -> TcOpenTypeDecl cenv scopem env synType + | SynOpenDeclTarget.Type synType -> TcOpenTypeDecl cenv m scopem env synType exception ParameterlessStructCtor of range @@ -14539,7 +14540,7 @@ module MutRecBindingChecking = let tycons = decls |> List.choose (function MutRecShape.Tycon d -> getTyconOpt d | _ -> None) let mspecs = decls |> List.choose (function MutRecShape.Module (MutRecDefnsPhase2DataForModule (_, mspec), _) -> Some mspec | _ -> None) let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) - let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (mp, isOpenType, m, moduleRange)) -> Some (mp, isOpenType, m, moduleRange) | _ -> None) + let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (target, m, moduleRange)) -> Some (target, m, moduleRange) | _ -> None) let lets = decls |> List.collect (function MutRecShape.Lets binds -> getVals binds | _ -> []) let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsExceptionDecl) @@ -17487,9 +17488,9 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d let decls = typeSpecs |> List.map MutRecShape.Tycon decls, (false, false) - | SynModuleSigDecl.Open (lid, isOpenType, m) -> + | SynModuleSigDecl.Open (target, m) -> if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) - let decls = [ MutRecShape.Open (MutRecDataForOpen(lid, isOpenType, m, moduleRange)) ] + let decls = [ MutRecShape.Open (MutRecDataForOpen(target, m, moduleRange)) ] decls, (openOk, moduleAbbrevOk) | SynModuleSigDecl.Exception (SynExceptionSig(exnRepr, members, _), _) -> diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index dc61d14983d..791eaad2a3b 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -3138,30 +3138,6 @@ let destReadOnlySpanTy g m ty = | ValueSome(struct(tcref, ty)) -> struct(tcref, ty) | _ -> failwith "destReadOnlySpanTy" -/// Is the type able to be opened? -/// F# does not support opening the following types: -/// - parameterized types -/// - type abbreviations -/// - measureable types -/// - special types from FSharp.Core -/// - delegate types -/// - hidden types -/// - erased types -/// - F# exception types -/// parameterized types, type abbreviations, measureable types, or special types from FSharp.Core. -let isOpenableTyconRef (tcref: TyconRef) = - // While a Tycon is an Entity and an Entity that is a module or namespace can be opened, - // we disallow it here to be explicit that this function only operates on type definitions. - not tcref.IsModuleOrNamespace && - tcref.TyparsNoRange.IsEmpty && - not tcref.IsTypeAbbrev && - not tcref.IsMeasureableReprTycon && - not tcref.IsAsmReprTycon && - not tcref.IsDelegateTycon && - not tcref.IsHiddenReprTycon && - not tcref.IsErased && - not tcref.IsExceptionDecl - //------------------------------------------------------------------------- // List and reference types... //------------------------------------------------------------------------- diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 74503b5f1b1..27394627a98 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2142,8 +2142,6 @@ val tryDestReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TTy val destReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) -val isOpenableTyconRef : TyconRef -> bool - //------------------------------------------------------------------------- // Tuple constructors/destructors //------------------------------------------------------------------------- diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 65238d1e608..8938a435ac6 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -288,11 +288,6 @@ let rangeOfLongIdent(lid:LongIdent) = %type exconDefn %type exconCore %type moduleDefnsOrExprPossiblyEmptyOrBlock -<<<<<<< HEAD -%type openDecl -%type openTypeDecl -======= ->>>>>>> dsyme/ostat1 %type path %type pathOp /* LESS GREATER parsedOk typeArgs m for each mWhole */ @@ -772,7 +767,7 @@ moduleSpfn: SynModuleSigDecl.Exception(ec, rhs parseState 3) } | openDecl - { let a,b = $1 in SynModuleSigDecl.Open (a, b) } + { SynModuleSigDecl.Open(a, (rhs parseState 1)) } valSpfn: | opt_attributes opt_declVisibility VAL opt_attributes opt_inline opt_mutable opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints optLiteralValueSpfn @@ -1266,15 +1261,15 @@ moduleDefn: /* 'open' declarations */ | openDecl - { let a,b = $1 in [ SynModuleDecl.Open(a, b)] } + { [ SynModuleDecl.Open(a, (rhs parseState 1)) ] } openDecl: /* 'open' declarations */ | OPEN path - { SynOpenDeclTarget.ModuleOrNamespace $2.Lid, unionRanges (rhs parseState 1) $2.Range } + { SynOpenDeclTarget.ModuleOrNamespace $2.Lid } | OPEN TYPE appType - { SynOpenDeclTarget.Type $3, unionRanges (rhs parseState 1) $3.Range } + { SynOpenDeclTarget.Type $3 } /* The right-hand-side of a module abbreviation definition */ /* This occurs on the right of a module abbreviation (#light encloses the r.h.s. with OBLOCKBEGIN/OBLOCKEND) */ diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 24a90a888c7..d473d0c00c2 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -851,15 +851,7 @@ type internal TypeCheckInfo |> List.filter (fun x -> match x.Item with | Item.ModuleOrNamespaces _ -> true - | Item.Types (_, tcrefs) - when isOpenType && - tcrefs - |> List.exists (fun ty -> - match ty with - | TType_app (tcref, _) when tcref.CanDeref -> - // Type abbreviations may have nested types that are valid, so show them. - tcref.IsTypeAbbrev || isOpenableTyconRef tcref - | _ -> false) -> true + | Item.Types _ when isOpenType -> true | _ -> false), denv, m) // Completion at '(x: ...)" diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index 172987c7e88..cb3b745b6d2 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -13,10 +13,10 @@ module UnusedOpens = let symbolHash = HashIdentity.FromFunctions (fun (x: FSharpSymbol) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) - /// Represents one namespace or module or type opened by an 'open'/'open type' declaration + /// Represents one namespace or module or type opened by an 'open' declaration type OpenedModule(entity: FSharpEntity, isNestedAutoOpen: bool) = - /// Compute an indexed table of the set of symbols revealed by 'open'/'open type', on-demand + /// Compute an indexed table of the set of symbols revealed by 'open', on-demand let revealedSymbols : Lazy> = lazy let symbols = @@ -43,7 +43,7 @@ module UnusedOpens = yield apCase :> FSharpSymbol // The IsNamespace and IsFSharpModule and IsOpenableType cases are handled by looking at DeclaringEntity below - if not entity.IsNamespace && not entity.IsFSharpModule && not entity.IsOpenableType then + if not entity.IsNamespace && not entity.IsFSharpModule then for fv in entity.MembersFunctionsAndValues do yield fv :> FSharpSymbol |] @@ -60,7 +60,7 @@ module UnusedOpens = let rec getModuleAndItsAutoOpens (isNestedAutoOpen: bool) (modul: FSharpEntity) = [ yield OpenedModule (modul, isNestedAutoOpen) for ent in modul.NestedEntities do - if (ent.IsFSharpModule || ent.IsOpenableType) && Symbol.hasAttribute ent.Attributes then + if (not ent.IsNamespace) && Symbol.hasAttribute ent.Attributes then yield! getModuleAndItsAutoOpens true ent ] { OpenedModules = getModuleAndItsAutoOpens false modul } @@ -136,7 +136,7 @@ module UnusedOpens = match symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some ent when ent.IsNamespace || ent.IsFSharpModule || ent.IsOpenableType -> true + | Some _ when not f.IsInstanceMember -> true | _ -> false | _ -> false) @@ -213,7 +213,7 @@ module UnusedOpens = match f.DeclaringEntity with // Show namespaces, modules, openable types, and type abbreviations. // We show type abbreviations because they may have nested types that could be accessed. - | Some entity when entity.IsNamespace || entity.IsFSharpModule || entity.IsOpenableType || entity.IsFSharpAbbreviation -> + | Some entity when not f.IsInstanceMember -> symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.RangeAlternate) | _ -> () | _ -> () diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index de9634741af..2d2739d95db 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -915,7 +915,7 @@ module ParsedInput = | SynModuleDecl.DoExpr (_, _, r) | SynModuleDecl.Types (_, r) | SynModuleDecl.Exception (_, r) - | SynModuleDecl.Open (_, _, r) + | SynModuleDecl.Open (_, r) | SynModuleDecl.HashDirective (_, r) -> Some r | _ -> None |> Option.map (fun r -> r.StartColumn) @@ -961,7 +961,7 @@ module ParsedInput = let moduleBodyIndentation = getMinColumn decls |> Option.defaultValue (range.StartColumn + 4) doRange NestedModule fullIdent range.StartLine moduleBodyIndentation List.iter (walkSynModuleDecl fullIdent) decls - | SynModuleDecl.Open (_, _, range) -> doRange OpenDeclaration [] range.EndLine (range.StartColumn - 5) + | SynModuleDecl.Open (_, range) -> doRange OpenDeclaration [] range.EndLine (range.StartColumn - 5) | SynModuleDecl.HashDirective (_, range) -> doRange HashDirective [] range.EndLine range.StartColumn | _ -> () diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index 5aa1bee12fc..7d00cead2b2 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -181,7 +181,7 @@ module public AstTraversal = | SynModuleDecl.DoExpr(_sequencePointInfoForBinding, synExpr, _range) -> traverseSynExpr path synExpr | SynModuleDecl.Types(synTypeDefnList, _range) -> synTypeDefnList |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path)) |> pick decl | SynModuleDecl.Exception(_synExceptionDefn, _range) -> None - | SynModuleDecl.Open(_longIdent, _isOpenType, _range) -> None + | SynModuleDecl.Open(_target, _range) -> None | SynModuleDecl.Attributes(_synAttributes, _range) -> None | SynModuleDecl.HashDirective(_parsedHashDirective, range) -> visitor.VisitHashDirective range | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace @@ -611,7 +611,7 @@ module public AstTraversal = let pick (debugObj:obj) = pick m.Range debugObj let path = TraverseStep.MemberDefn m :: path match m with - | SynMemberDefn.Open(_longIdent, _isOpenType, _range) -> None + | SynMemberDefn.Open(_longIdent, _range) -> None | SynMemberDefn.Member(synBinding, _range) -> traverseSynBinding path synBinding | SynMemberDefn.ImplicitCtor(_synAccessOption, _synAttributes, simplePats, _identOption, _range) -> match simplePats with diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index 6e030ce75ea..2de95ace338 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -586,7 +586,7 @@ module Structure = |> List.choose selectRanges |> acc.AddRange - let collectOpens = getConsecutiveModuleDecls (function SynModuleDecl.Open (_, _, r) -> Some r | _ -> None) Scope.Open + let collectOpens = getConsecutiveModuleDecls (function SynModuleDecl.Open (_, r) -> Some r | _ -> None) Scope.Open let collectHashDirectives = getConsecutiveModuleDecls( @@ -730,7 +730,7 @@ module Structure = | SynModuleSigDecl.Types (typeSigs, r) -> lastTypeDefnSigRangeElse r typeSigs | SynModuleSigDecl.Val (ValSpfn(range=r), _) -> r | SynModuleSigDecl.Exception(_, r) -> r - | SynModuleSigDecl.Open(_, _, r) -> r + | SynModuleSigDecl.Open(_, r) -> r | SynModuleSigDecl.ModuleAbbrev(_, _, r) -> r | _ -> range @@ -821,7 +821,7 @@ module Structure = Some (mkRange "" (mkPos r.StartLine prefixLength) r.End) | _ -> None) Scope.HashDirective - let collectSigOpens = getConsecutiveSigModuleDecls (function SynModuleSigDecl.Open (_, _, r) -> Some r | _ -> None) Scope.Open + let collectSigOpens = getConsecutiveSigModuleDecls (function SynModuleSigDecl.Open (_, r) -> Some r | _ -> None) Scope.Open let rec parseModuleSigDeclaration (decl: SynModuleSigDecl) = match decl with diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index eecdbbdf343..71e2d142d86 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -1325,7 +1325,7 @@ module UntypedParseImpl = member __.VisitModuleDecl(defaultTraverse, decl) = match decl with - | SynModuleDecl.Open(_, isOpenType, m) -> + | SynModuleDecl.Open(target, m) -> // in theory, this means we're "in an open" // in practice, because the parse tree/walkers do not handle attributes well yet, need extra check below to ensure not e.g. $here$ // open System @@ -1333,7 +1333,11 @@ module UntypedParseImpl = // let f() = () // inside an attribute on the next item let pos = mkPos pos.Line (pos.Column - 1) // -1 because for e.g. "open System." the dot does not show up in the parse tree - if rangeContainsPos m pos then + if rangeContainsPos m pos then + let isOpenType = + match target with + | SynOpenDeclTarget.Type _ -> true + | SynOpenDeclTarget.ModuleOrNamespace _ -> false Some (CompletionContext.OpenDeclaration isOpenType) else None diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 4569449e020..fbc4eb936b7 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -532,9 +532,6 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member __.IsFSharpUnion = isResolvedAndFSharp() && entity.IsUnionTycon - member __.IsOpenableType = - isResolved() && isOpenableTyconRef entity - member __.HasAssemblyCodeRepresentation = isResolvedAndFSharp() && (entity.IsAsmReprTycon || entity.IsMeasureableReprTycon) diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 009bed5484b..23736fcb832 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -190,9 +190,6 @@ and [] public FSharpEntity = /// Indicates if the entity is union type member IsFSharpUnion : bool - /// Indicates if the entity is a type that can be opened via 'open type' declarations - member IsOpenableType : bool - /// Indicates if the entity is a struct or enum member IsValueType : bool From d885764af9bb4f2012452d3a3368cbebf73dd70e Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 24 Jun 2020 16:28:33 -0700 Subject: [PATCH 12/89] Fixing build --- src/fsharp/NameResolution.fs | 31 +++++++------------ src/fsharp/NameResolution.fsi | 16 +++++----- src/fsharp/TypedTree.fs | 12 ------- src/fsharp/fsi/fsi.fsproj | 2 +- src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj | 2 +- src/fsharp/pars.fsy | 4 +-- src/fsharp/service/ServiceAnalysis.fs | 2 +- .../Language/DefaultInterfaceMemberTests.fs | 12 ++----- tests/service/InteractiveCheckerTests.fs | 3 +- 9 files changed, 29 insertions(+), 55 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index d1365355d78..47494daafd7 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2116,23 +2116,8 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities // Consume ids that refer to a namespace, module, or type //------------------------------------------------------------------------- -let ResolveNestedTypeThroughAbbreviation g (tcref: TyconRef) m = - if tcref.IsTypeAbbrev && tcref.Typars(m).IsEmpty then - match tryAppTy g tcref.TypeAbbrev.Value with - | ValueSome (abbrevTcref, []) -> abbrevTcref - | _ -> tcref - else - tcref - -/// If we are not looking up a type, then always lookup a module or namespace. -/// If we are looking up a type, but the rest is not empty, we need to lookup a module or namespace. -let CanLookupModuleOrNamespace (rest: Ident list) isType = - not isType || (isType && not rest.IsEmpty) - /// Perform name resolution for an identifier which must resolve to be a module or namespace. let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl = - let g = amap.g - if first && id.idText = MangledGlobalName then match rest with | [] -> @@ -2185,7 +2170,6 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet if not modrefs.IsEmpty then /// Look through the sub-namespaces and/or modules let rec look depth (modref: ModuleOrNamespaceRef) (lid: Ident list) = - let modref = if not lid.IsEmpty then ResolveNestedTypeThroughAbbreviation g modref m else modref let mty = modref.ModuleOrNamespaceType match lid with | [] -> @@ -2992,10 +2976,17 @@ let ResolvePatternLongIdent sink (ncenv: NameResolver) warnOnUpper newDef m ad n // // X.ListEnumerator // does not resolve // +let ResolveNestedTypeThroughAbbreviation (ncenv: NameResolver) (tcref: TyconRef) m = + if tcref.IsTypeAbbrev && tcref.Typars(m).IsEmpty then + match tryAppTy ncenv.g tcref.TypeAbbrev.Value with + | ValueSome (abbrevTcref, []) -> abbrevTcref + | _ -> tcref + else + tcref /// Resolve a long identifier representing a type name let rec ResolveTypeLongIdentInTyconRefPrim (ncenv: NameResolver) (typeNameResInfo: TypeNameResolutionInfo) ad resInfo genOk depth m (tcref: TyconRef) (id: Ident) (rest: Ident list) = - let tcref = ResolveNestedTypeThroughAbbreviation ncenv.g tcref m + let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m match rest with | [] -> #if !NO_EXTENSIONTYPING @@ -4131,7 +4122,7 @@ let TryToResolveLongIdentAsType (ncenv: NameResolver) (nenv: NameResolutionEnv) LookupTypeNameInEnvNoArity OpenQualified id nenv |> List.tryHead |> Option.map (fun tcref -> - let tcref = ResolveNestedTypeThroughAbbreviation g tcref m + let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m FreshenTycon ncenv m tcref) | _ -> None @@ -4228,7 +4219,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE [ if not isItemVal then // type.lookup: lookup a static something in a type for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do - let tcref = ResolveNestedTypeThroughAbbreviation g tcref m + let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m let ty = FreshenTycon ncenv m tcref yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty ] @@ -4812,7 +4803,7 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a | _ -> // type.lookup: lookup a static something in a type for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do - let tcref = ResolveNestedTypeThroughAbbreviation g tcref m + let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m let ty = FreshenTycon ncenv m tcref yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item ty } diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 6b91265ce5f..9a3a139b4cd 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -530,28 +530,28 @@ type PermitDirectReferenceToGeneratedType = | No /// Resolve a long identifier to a namespace, module. -val internal ResolveLongIdentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > +val internal ResolveLongIdentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > /// Resolve a long identifier to an object constructor. -val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException +val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException /// Resolve a long identifier using type-qualified name resolution. -val internal ResolveLongIdentInType : TcResultsSink -> NameResolver -> NameResolutionEnv -> LookupKind -> range -> AccessorDomain -> Ident -> FindMemberFlag -> TypeNameResolutionInfo -> TType -> Item * Ident list +val internal ResolveLongIdentInType : TcResultsSink -> NameResolver -> NameResolutionEnv -> LookupKind -> range -> AccessorDomain -> Ident -> FindMemberFlag -> TypeNameResolutionInfo -> TType -> Item * Ident list /// Resolve a long identifier when used in a pattern. -val internal ResolvePatternLongIdent : TcResultsSink -> NameResolver -> WarnOnUpperFlag -> bool -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item +val internal ResolvePatternLongIdent : TcResultsSink -> NameResolver -> WarnOnUpperFlag -> bool -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item /// Resolve a long identifier representing a type name -val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResolver -> NameResolutionEnv -> TypeNameResolutionInfo -> AccessorDomain -> range -> ModuleOrNamespaceRef -> Ident list -> TyconRef +val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResolver -> NameResolutionEnv -> TypeNameResolutionInfo -> AccessorDomain -> range -> ModuleOrNamespaceRef -> Ident list -> TyconRef /// Resolve a long identifier to a type definition -val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException +val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException /// Resolve a long identifier to a field -val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list +val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list /// Resolve a long identifier occurring in an expression position -val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * Ident list +val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * Ident list /// Resolve a (possibly incomplete) long identifier to a loist of possible class or record fields val internal ResolvePartialLongIdentToClassOrRecdFields : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> bool -> Item list diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 22b162ee70a..f0aeb5bf7bb 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -1082,12 +1082,6 @@ type Entity = /// Indicates if this is an F#-defined class type definition member x.IsFSharpClassTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconClass -> true | _ -> false - /// Indicates if this is a .NET-defined delegate type definition - member x.IsILDelegateTycon = x.IsILTycon && x.ILTyconRawMetadata.IsDelegate - - /// Indicates if this is a delegate type definition - member x.IsDelegateTycon = x.IsFSharpDelegateTycon || x.IsILDelegateTycon - /// Indicates if this is a .NET-defined enum type definition member x.IsILEnumTycon = x.IsILTycon && x.ILTyconRawMetadata.IsEnum @@ -3547,12 +3541,6 @@ type EntityRef = /// Indicates if this is an F#-defined enum type definition member x.IsFSharpEnumTycon = x.Deref.IsFSharpEnumTycon - /// Indicates if this is a .NET-defined delegate type definition - member x.IsILDelegateTycon = x.Deref.IsILDelegateTycon - - /// Indicates if this is a delegate type definition - member x.IsDelegateTycon = x.Deref.IsDelegateTycon - /// Indicates if this is a .NET-defined enum type definition member x.IsILEnumTycon = x.Deref.IsILEnumTycon diff --git a/src/fsharp/fsi/fsi.fsproj b/src/fsharp/fsi/fsi.fsproj index c28e975ff69..32591e18d2e 100644 --- a/src/fsharp/fsi/fsi.fsproj +++ b/src/fsharp/fsi/fsi.fsproj @@ -17,7 +17,7 @@ x86 - $(DefineConstants);FSI_SERVER + $(DefineConstants);FSI_SHADOW_COPY_REFERENCES;FSI_SERVER diff --git a/src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj b/src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj index b73c60db2ef..d39051b414c 100644 --- a/src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj +++ b/src/fsharp/fsiAnyCpu/fsiAnyCpu.fsproj @@ -16,7 +16,7 @@ - $(DefineConstants);FSI_SERVER + $(DefineConstants);FSI_SHADOW_COPY_REFERENCES;FSI_SERVER diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 8938a435ac6..564cba0511a 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -767,7 +767,7 @@ moduleSpfn: SynModuleSigDecl.Exception(ec, rhs parseState 3) } | openDecl - { SynModuleSigDecl.Open(a, (rhs parseState 1)) } + { SynModuleSigDecl.Open($1, (rhs parseState 1)) } valSpfn: | opt_attributes opt_declVisibility VAL opt_attributes opt_inline opt_mutable opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints optLiteralValueSpfn @@ -1261,7 +1261,7 @@ moduleDefn: /* 'open' declarations */ | openDecl - { [ SynModuleDecl.Open(a, (rhs parseState 1)) ] } + { [ SynModuleDecl.Open($1, (rhs parseState 1)) ] } openDecl: /* 'open' declarations */ diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index cb3b745b6d2..a982b7f6782 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -42,7 +42,7 @@ module UnusedOpens = for apCase in entity.ActivePatternCases do yield apCase :> FSharpSymbol - // The IsNamespace and IsFSharpModule and IsOpenableType cases are handled by looking at DeclaringEntity below + // The IsNamespace and IsFSharpModule cases are handled by looking at DeclaringEntity below if not entity.IsNamespace && not entity.IsFSharpModule then for fv in entity.MembersFunctionsAndValues do yield fv :> FSharpSymbol |] diff --git a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs index 0cd28990f69..eda3cdca91a 100644 --- a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs +++ b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs @@ -7,19 +7,13 @@ open FSharp.Test.Utilities open FSharp.Test.Utilities.Utilities open FSharp.Compiler.SourceCodeServices -[] -module private DefaultInterfaceMemberConsumptionLanguageVersion = - - [] - let targetVersion = "5.0" - #if NETCOREAPP [] module DefaultInterfaceMemberConsumptionTests_LanguageVersion_4_6 = [] - let targetVersion = "'preview'" + let targetVersion = "5.0" [] let ``IL - Errors with lang version not supported`` () = @@ -953,7 +947,7 @@ type Test2 () = module DefaultInterfaceMemberConsumptionTests_LanguageVersion_4_6_net472 = [] - let targetVersion = "'preview'" + let targetVersion = "5.0" [] let ``IL - Errors with lang version and target runtime not supported`` () = @@ -4964,7 +4958,7 @@ let f () = module DefaultInterfaceMemberConsumptionTests_net472 = [] - let targetVersion = "'preview'" + let targetVersion = "5.0" [] let ``IL - Errors with target runtime not supported`` () = diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index 9b637dddf37..a1fe720339f 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -42,7 +42,8 @@ let internal identsAndRanges (input: ParsedInput) = | SynModuleDecl.Let(_, _, _) -> failwith "Not implemented yet" | SynModuleDecl.DoExpr(_, _, _range) -> failwith "Not implemented yet" | SynModuleDecl.Exception(_, _range) -> failwith "Not implemented yet" - | SynModuleDecl.Open(lid, range) -> [ identAndRange (longIdentToString lid) range ] + | SynModuleDecl.Open(SynOpenDeclTarget.ModuleOrNamespace lid, range) -> [ identAndRange (longIdentToString lid) range ] + | SynModuleDecl.Open(SynOpenDeclTarget.Type _, _) -> failwith "Not implemented yet" | SynModuleDecl.Attributes(_attrs, _range) -> failwith "Not implemented yet" | SynModuleDecl.HashDirective(_, _range) -> failwith "Not implemented yet" | SynModuleDecl.NamespaceFragment(moduleOrNamespace) -> extractFromModuleOrNamespace moduleOrNamespace From 6ebd9719cbeeb457014e8fb5eecbae0145e06b85 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 24 Jun 2020 16:53:25 -0700 Subject: [PATCH 13/89] Fixing some tests --- src/fsharp/pars.fsy | 2 +- .../Language/OpenTypeDeclarationTests.fs | 22 ++++++++----------- 2 files changed, 10 insertions(+), 14 deletions(-) diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 564cba0511a..531f7290a5b 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -1268,7 +1268,7 @@ openDecl: | OPEN path { SynOpenDeclTarget.ModuleOrNamespace $2.Lid } - | OPEN TYPE appType + | OPEN typeKeyword appType { SynOpenDeclTarget.Type $3 } /* The right-hand-side of a module abbreviation definition */ diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 3c1556caafb..ba681552bf1 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -49,7 +49,7 @@ module OpenSystemMathOnce = open type System.Math let x = Min(1.0, 2.0)""") [| - (FSharpErrorSeverity.Error, 3350, (22, 26, 22, 37), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (FSharpErrorSeverity.Error, 3350, (22, 16, 22, 37), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (23,24,23,27), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") |] @@ -77,9 +77,9 @@ module OpenSystemMathTwice = open type System.Math let x2 = Min(2.0, 1.0)""") [| - (FSharpErrorSeverity.Error, 3350, (22, 15, 22, 26), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (FSharpErrorSeverity.Error, 3350, (22, 5, 22, 26), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (23,13,23,16), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") - (FSharpErrorSeverity.Error, 3350, (25, 15, 25, 26), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (FSharpErrorSeverity.Error, 3350, (25, 5, 25, 26), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (26,14,26,17), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") |] @@ -105,7 +105,7 @@ module OpenMyMathOnce = let x = Min(1.0, 2.0) let x2 = Min(1, 2)""") [| - (FSharpErrorSeverity.Error, 3350, (22, 15, 22, 21), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (FSharpErrorSeverity.Error, 3350, (22, 5, 22, 21), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (23,13,23,16), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") (FSharpErrorSeverity.Error, 39, (24,14,24,17), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") |] @@ -159,7 +159,7 @@ module OpenAutoMath = let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") [| - (FSharpErrorSeverity.Error, 3350, (21, 15, 21, 29), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (FSharpErrorSeverity.Error, 3350, (21, 5, 21, 29), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") (FSharpErrorSeverity.Error, 39, (24,13,24,20), "The value or constructor 'AutoMin' is not defined.") (FSharpErrorSeverity.Error, 39, (25,14,25,21), "The value or constructor 'AutoMin' is not defined.") |] @@ -283,7 +283,7 @@ open type Abbrev.NestedTest CompilerAssert.Compile(fsCmpl) [] - let ``Open a type where the type declaration uses a type abbreviation - Error`` () = + let ``Open a type where the type declaration uses a type abbreviation`` () = let csharpSource = """ using System; @@ -325,9 +325,7 @@ open type Abbrev let fsCmpl = Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - CompilerAssert.CompileWithErrors(fsCmpl, [| - (FSharpErrorSeverity.Error, 39, (6, 11, 6, 17), "The type 'Abbrev' is not defined.") - |]) + CompilerAssert.Compile(fsCmpl) [] let ``Open a nested type as qualified`` () = @@ -370,7 +368,7 @@ module Test = CompilerAssert.Compile(fsCmpl) [] - let ``Open generic type and use nested types as unqualified - Error`` () = + let ``Open generic type and use nested types as unqualified`` () = let csharpSource = """ using System; @@ -419,9 +417,7 @@ module Test = let fsCmpl = Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - CompilerAssert.CompileWithErrors(fsCmpl, [| - (FSharpErrorSeverity.Error, 10, (5, 26, 5, 27), "Unexpected type application in implementation file. Expected incomplete structured construct at or before this point or other token.") - |]) + CompilerAssert.Compile(fsCmpl) [] let ``Using the 'open' declaration on a possible type identifier - Error`` () = From 4135fced151d1205c4e2d0035b14f25d57c57679 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 24 Jun 2020 18:41:12 -0700 Subject: [PATCH 14/89] Trying to figure out nested --- src/fsharp/NameResolution.fs | 32 +++++++++++-------- .../Language/OpenTypeDeclarationTests.fs | 6 ++-- 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 47494daafd7..10cdfc4cfb4 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1021,7 +1021,7 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( match optFilter with | Some nm -> LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo, tcref) - |> List.map (fun tcref -> (tinst, tcref)) + |> List.map (fun tcref -> (tinst @ (tcref.Typars(m) |> List.map mkTyparTy), tcref)) | None -> #if !NO_EXTENSIONTYPING match tycon.TypeReprInfo with @@ -1030,14 +1030,14 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( let nestedTypeName = nestedType.PUntaint((fun t -> t.Name), m) yield! LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nestedTypeName, staticResInfo, tcref) - |> List.map (fun tcref -> (tinst, tcref)) ] + |> List.map (fun tcref -> ((tinst @ (tcref.Typars(m) |> List.map mkTyparTy), tcref))) ] | _ -> #endif mty.TypesByAccessNames.Values |> List.choose (fun entity -> let tcref = tcref.NestedTyconRef entity - if IsEntityAccessible amap m ad tcref then Some (tinst, tcref) else None) + if IsEntityAccessible amap m ad tcref then Some ((tinst @ (tcref.Typars(m) |> List.map mkTyparTy)), tcref) else None) | _ -> []) /// Make a type that refers to a nested type. @@ -1054,12 +1054,7 @@ let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, che GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty |> List.map (fun (tinst, tcref) -> MakeNestedType ncenv tinst m tcref) -let MakeNestedTypeNoInstantiation (tinst: TType list) m (tcrefNested: TyconRef) = - let tps = List.skip tinst.Length (tcrefNested.Typars m) - let tinstNested = tps |> List.map mkTyparTy - mkAppTy tcrefNested (tinst @ tinstNested) - -let GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty = +let GetNestedTypesOfTypeAsUnqualifiedItems infoReader (amap: Import.ImportMap) ad m ty = let nestedTcrefGroups = GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty |> List.groupBy (fun (_, m) -> DemangleGenericTypeName m.LogicalName) @@ -1069,25 +1064,36 @@ let GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty = let nested = nestedTypeGroups |> List.map (fun (_, tcref) -> tcref) + yield KeyValuePair(nestedTypeName, Item.UnqualifiedType(nested)) } -let AddStaticContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = +let rec AddStaticContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) + let nestedItems = GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty let items = [| - yield! GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty + yield! nestedItems yield! GetStaticMethodItems infoReader nenv ad m ty yield! GetStaticPropertyItems infoReader nenv ad m ty yield! GetStaticILFieldItems infoReader ad m ty yield! GetStaticEventItems infoReader ad m ty |] + //let nenv = + // (nenv, nestedItems) + // ||> Seq.fold (fun nenv kv -> + // match kv.Value with + // | Item.UnqualifiedType nestedTcrefs -> + // Item. + // AddTyconRefsToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv nestedTcrefs + // | _ -> nenv) + { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } /// Add any implied contents of a type definition to the environment. -let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = +and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = let isIL = tcref.IsILTycon let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef @@ -1170,7 +1176,7 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) nenv /// Add a set of type definitions to the name resolution environment -let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs = +and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs = if isNil tcrefs then nenv else let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap ad m) nenv tcrefs // Add most of the contents of the tycons en-masse, then flatten the tables if we're opening a module or namespace diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index ba681552bf1..1f73e66cb06 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -404,9 +404,9 @@ open System open type CSharpTest.Test module Test = - let x = NestedTest() - let y = NestedTest() - let a = x.A() + // let x: NestedTest = NestedTest() + let y: CSharpTest.Test.NestedTest = NestedTest() + // let a = x.A() let b = y.B() """ From a3f16dcc88c96235b9134c8885abd466d83220c8 Mon Sep 17 00:00:00 2001 From: TIHan Date: Sat, 27 Jun 2020 18:06:34 -0700 Subject: [PATCH 15/89] Added eUnqualifiedTyconTypeArgs --- src/fsharp/NameResolution.fs | 57 +++++++++---------- src/fsharp/NameResolution.fsi | 3 + .../Language/OpenTypeDeclarationTests.fs | 4 +- 3 files changed, 33 insertions(+), 31 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 10cdfc4cfb4..eba31e256f5 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -334,6 +334,9 @@ type NameResolutionEnv = /// Values, functions, methods and other items available by unqualified name eUnqualifiedItems: UnqualifiedItems + /// Type arguments that are associated with an unqualified type item + eUnqualifiedTyconTypeArgs: TyconRefMap + /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap @@ -392,6 +395,7 @@ type NameResolutionEnv = eFullyQualifiedModulesAndNamespaces = Map.empty eFieldLabels = Map.empty eUnqualifiedItems = LayeredMap.Empty + eUnqualifiedTyconTypeArgs = TyconRefMap.Empty ePatItems = Map.empty eTyconsByAccessNames = LayeredMultiMap.Empty eTyconsByDemangledNameAndArity = LayeredMap.Empty @@ -1021,7 +1025,7 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( match optFilter with | Some nm -> LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo, tcref) - |> List.map (fun tcref -> (tinst @ (tcref.Typars(m) |> List.map mkTyparTy), tcref)) + |> List.map (fun tcref -> (tcref, tinst @ (tcref.Typars(m) |> List.map mkTyparTy))) | None -> #if !NO_EXTENSIONTYPING match tycon.TypeReprInfo with @@ -1030,14 +1034,14 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( let nestedTypeName = nestedType.PUntaint((fun t -> t.Name), m) yield! LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nestedTypeName, staticResInfo, tcref) - |> List.map (fun tcref -> ((tinst @ (tcref.Typars(m) |> List.map mkTyparTy), tcref))) ] + |> List.map (fun tcref -> (tcref, (tinst @ (tcref.Typars(m) |> List.map mkTyparTy)))) ] | _ -> #endif mty.TypesByAccessNames.Values |> List.choose (fun entity -> let tcref = tcref.NestedTyconRef entity - if IsEntityAccessible amap m ad tcref then Some ((tinst @ (tcref.Typars(m) |> List.map mkTyparTy)), tcref) else None) + if IsEntityAccessible amap m ad tcref then Some (tcref, (tinst @ (tcref.Typars(m) |> List.map mkTyparTy))) else None) | _ -> []) /// Make a type that refers to a nested type. @@ -1052,46 +1056,41 @@ let MakeNestedType (ncenv: NameResolver) (tinst: TType list) m (tcrefNested: Tyc /// Get all the accessible nested types of an existing type. let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, checkForGenerated, m) ty = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty - |> List.map (fun (tinst, tcref) -> MakeNestedType ncenv tinst m tcref) - -let GetNestedTypesOfTypeAsUnqualifiedItems infoReader (amap: Import.ImportMap) ad m ty = - let nestedTcrefGroups = - GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty - |> List.groupBy (fun (_, m) -> DemangleGenericTypeName m.LogicalName) - - seq { - for (nestedTypeName, nestedTypeGroups) in nestedTcrefGroups do - let nested = - nestedTypeGroups - |> List.map (fun (_, tcref) -> tcref) - - yield KeyValuePair(nestedTypeName, Item.UnqualifiedType(nested)) - } + |> List.map (fun (tcref, tinst) -> MakeNestedType ncenv tinst m tcref) let rec AddStaticContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) - let nestedItems = GetNestedTypesOfTypeAsUnqualifiedItems infoReader amap ad m ty let items = [| - yield! nestedItems yield! GetStaticMethodItems infoReader nenv ad m ty yield! GetStaticPropertyItems infoReader nenv ad m ty yield! GetStaticILFieldItems infoReader ad m ty yield! GetStaticEventItems infoReader ad m ty |] - //let nenv = - // (nenv, nestedItems) - // ||> Seq.fold (fun nenv kv -> - // match kv.Value with - // | Item.UnqualifiedType nestedTcrefs -> - // Item. - // AddTyconRefsToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv nestedTcrefs - // | _ -> nenv) - { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } + let nenv = { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } + AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty +and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad m nenv ty = + let nestedTcrefGroups = + GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty + |> List.groupBy (fun (tcref, _) -> DemangleGenericTypeName tcref.LogicalName) + + (nenv, nestedTcrefGroups) + ||> List.fold (fun nenv (_, nestedTypes) -> + AddTyconRefsWithTypeArgsToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv nestedTypes + ) + +and private AddTyconRefsWithTypeArgsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tcrefsWithArgs: (TyconRef * TTypes) list) = + let tcrefs = tcrefsWithArgs |> List.map (fun (tcref, _) -> tcref) + let nenv = AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs + (nenv, tcrefsWithArgs) + ||> List.fold (fun nenv (tcref, tinst) -> + if tinst.IsEmpty then nenv + else { nenv with eUnqualifiedTyconTypeArgs = nenv.eUnqualifiedTyconTypeArgs.Add tcref tinst }) + /// Add any implied contents of a type definition to the environment. and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 9a3a139b4cd..203fc040b2e 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -160,6 +160,9 @@ type NameResolutionEnv = /// Values and Data Tags available by unqualified name eUnqualifiedItems: LayeredMap + /// Type arguments that are associated with an unqualified type item + eUnqualifiedTyconTypeArgs: TyconRefMap + /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 1f73e66cb06..11ac9f9158b 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -387,9 +387,9 @@ namespace CSharpTest public class NestedTest { - public (T, U) B() + public U B() { - return (default(T), default(U)); + return default(U); } } } From d3e4bbf27dc3087077a3c01d40540e7b25b0ea38 Mon Sep 17 00:00:00 2001 From: TIHan Date: Sat, 27 Jun 2020 21:08:25 -0700 Subject: [PATCH 16/89] Properly opening generic types with nested generic types --- src/fsharp/NameResolution.fs | 44 ++++++++++++++----- src/fsharp/NameResolution.fsi | 2 +- .../Language/OpenTypeDeclarationTests.fs | 9 ++-- 3 files changed, 38 insertions(+), 17 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index eba31e256f5..61a0236f00e 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -335,7 +335,7 @@ type NameResolutionEnv = eUnqualifiedItems: UnqualifiedItems /// Type arguments that are associated with an unqualified type item - eUnqualifiedTyconTypeArgs: TyconRefMap + eUnqualifiedTyconTypeArgs: TyconRefMap /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap @@ -1025,7 +1025,7 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( match optFilter with | Some nm -> LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo, tcref) - |> List.map (fun tcref -> (tcref, tinst @ (tcref.Typars(m) |> List.map mkTyparTy))) + |> List.map (fun tcref -> (tcref, tinst)) | None -> #if !NO_EXTENSIONTYPING match tycon.TypeReprInfo with @@ -1034,14 +1034,14 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( let nestedTypeName = nestedType.PUntaint((fun t -> t.Name), m) yield! LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nestedTypeName, staticResInfo, tcref) - |> List.map (fun tcref -> (tcref, (tinst @ (tcref.Typars(m) |> List.map mkTyparTy)))) ] + |> List.map (fun tcref -> (tcref, tinst)) ] | _ -> #endif mty.TypesByAccessNames.Values |> List.choose (fun entity -> let tcref = tcref.NestedTyconRef entity - if IsEntityAccessible amap m ad tcref then Some (tcref, (tinst @ (tcref.Typars(m) |> List.map mkTyparTy))) else None) + if IsEntityAccessible amap m ad tcref then Some (tcref, tinst) else None) | _ -> []) /// Make a type that refers to a nested type. @@ -1079,17 +1079,15 @@ and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad |> List.groupBy (fun (tcref, _) -> DemangleGenericTypeName tcref.LogicalName) (nenv, nestedTcrefGroups) - ||> List.fold (fun nenv (_, nestedTypes) -> - AddTyconRefsWithTypeArgsToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv nestedTypes - ) + ||> List.fold (fun nenv (_, nestedTypes) -> AddTyconRefsWithTypeArgsToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv nestedTypes) and private AddTyconRefsWithTypeArgsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tcrefsWithArgs: (TyconRef * TTypes) list) = let tcrefs = tcrefsWithArgs |> List.map (fun (tcref, _) -> tcref) let nenv = AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs (nenv, tcrefsWithArgs) - ||> List.fold (fun nenv (tcref, tinst) -> - if tinst.IsEmpty then nenv - else { nenv with eUnqualifiedTyconTypeArgs = nenv.eUnqualifiedTyconTypeArgs.Add tcref tinst }) + ||> List.fold (fun nenv (tcref, tinstDeclaring) -> + if tinstDeclaring.IsEmpty then nenv + else { nenv with eUnqualifiedTyconTypeArgs = nenv.eUnqualifiedTyconTypeArgs.Add tcref tinstDeclaring }) /// Add any implied contents of a type definition to the environment. and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = @@ -1343,6 +1341,14 @@ let FreshenTycon (ncenv: NameResolver) m (tcref: TyconRef) = let improvedTy = ncenv.g.decompileType tcref tinst improvedTy +/// Convert a reference to a named nested type into a type that includes +/// a fresh set of inference type variables for the type parameters and the given type arguments. +let FreshenNestedTycon (ncenv: NameResolver) m (tcrefNested: TyconRef) (tinstDeclaring: TypeInst) = + let tps = ncenv.InstantiationGenerator m (tcrefNested.Typars m) + let tinstNested = List.skip tinstDeclaring.Length tps + let improvedTy = ncenv.g.decompileType tcrefNested (tinstDeclaring @ tinstNested) + improvedTy + /// Convert a reference to a union case into a UnionCaseInfo that includes /// a fresh set of inference type variables for the type parameters of the union type. let FreshenUnionCaseRef (ncenv: NameResolver) m (ucref: UnionCaseRef) = @@ -2607,12 +2613,26 @@ let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameR let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) match typeNameResInfo.ResolutionFlag with | ResolveTypeNamesToCtors -> - let tys = tcrefs |> List.map (fun (resInfo, tcref) -> (resInfo, FreshenTycon ncenv m tcref)) + let tys = + tcrefs + |> List.map (fun (resInfo, tcref) -> + match nenv.eUnqualifiedTyconTypeArgs.TryFind tcref with + | None -> + (resInfo, FreshenTycon ncenv m tcref) + | Some tinst -> + (resInfo, FreshenNestedTycon ncenv m tcref tinst)) tys |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) | ResolveTypeNamesToTypeRefs -> - let tys = tcrefs |> List.map (fun (resInfo, tcref) -> (resInfo, FreshenTycon ncenv m tcref)) + let tys = + tcrefs + |> List.map (fun (resInfo, tcref) -> + match nenv.eUnqualifiedTyconTypeArgs.TryFind tcref with + | None -> + (resInfo, FreshenTycon ncenv m tcref) + | Some tinst -> + (resInfo, FreshenNestedTycon ncenv m tcref tinst)) success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty]), []))) /// Resolve F# "A.B.C" syntax in expressions diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 203fc040b2e..bef74c265f1 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -161,7 +161,7 @@ type NameResolutionEnv = eUnqualifiedItems: LayeredMap /// Type arguments that are associated with an unqualified type item - eUnqualifiedTyconTypeArgs: TyconRefMap + eUnqualifiedTyconTypeArgs: TyconRefMap /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 11ac9f9158b..ee28e55fb44 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -404,10 +404,11 @@ open System open type CSharpTest.Test module Test = - // let x: NestedTest = NestedTest() - let y: CSharpTest.Test.NestedTest = NestedTest() - // let a = x.A() - let b = y.B() + let x = NestedTest() + let xb = x.B() + + let y = NestedTest() + let ya = y.A() """ let csCmpl = From c4f9a93478ae96c31c2a00aba2ee36d8307391eb Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 03:56:43 -0700 Subject: [PATCH 17/89] Update test baseline --- src/fsharp/TypeChecker.fs | 1 - tests/fsharp/typecheck/sigs/neg95.bsl | 8 ++++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index b72000fae9d..06a292dc66e 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3636,7 +3636,6 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = //------------------------------------------------------------------------- type MutRecDataForOpen = MutRecDataForOpen of SynOpenDeclTarget * range * appliedScope: range -type MutRecDataForOpenType = MutRecDataForOpenType of SynType * range * appliedScope: range type MutRecDataForModuleAbbrev = MutRecDataForModuleAbbrev of Ident * LongIdent * range /// Represents the shape of a mutually recursive group of declarations including nested modules diff --git a/tests/fsharp/typecheck/sigs/neg95.bsl b/tests/fsharp/typecheck/sigs/neg95.bsl index 378917767a9..48eddb2718a 100644 --- a/tests/fsharp/typecheck/sigs/neg95.bsl +++ b/tests/fsharp/typecheck/sigs/neg95.bsl @@ -1,15 +1,15 @@ neg95.fs(3,5,3,26): typecheck error FS3199: The 'rec' on this module is implied by an outer 'rec' declaration and is being ignored -neg95.fs(11,12,11,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module +neg95.fs(11,7,11,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module neg95.fs(19,7,19,22): typecheck error FS3201: In a recursive declaration group, module abbreviations must come after all 'open' declarations and before other declarations -neg95.fs(26,12,26,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module +neg95.fs(26,7,26,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module -neg95.fs(32,12,32,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module +neg95.fs(32,7,32,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module -neg95.fs(39,12,39,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module +neg95.fs(39,7,39,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module neg95.fs(45,10,45,22): typecheck error FS0954: This type definition involves an immediate cyclic reference through a struct field or inheritance relation From 94c0892ac04e7ecb8cf30cab91938f8a57b42447 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 04:37:28 -0700 Subject: [PATCH 18/89] Include range on target --- src/fsharp/SyntaxTree.fs | 15 +++++++++++++-- src/fsharp/TypeChecker.fs | 34 +++++++++++++++++----------------- src/fsharp/pars.fsy | 4 ++-- 3 files changed, 32 insertions(+), 21 deletions(-) diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs index f824885d6fb..4bef31bc68d 100644 --- a/src/fsharp/SyntaxTree.fs +++ b/src/fsharp/SyntaxTree.fs @@ -2019,10 +2019,21 @@ type SynModuleDecl = | SynModuleDecl.NamespaceFragment (SynModuleOrNamespace (range=m)) | SynModuleDecl.Attributes (range=m) -> m +/// Represents the target of the open declaration [] type SynOpenDeclTarget = - | ModuleOrNamespace of Ident list - | Type of SynType + + /// A 'open' declaration + | ModuleOrNamespace of longId: LongIdent * range: range + + /// A 'open type' declaration + | Type of typeName: SynType * range: range + + /// Gets the syntax range of this construct + member this.Range = + match this with + | ModuleOrNamespace (range=m) -> m + | Type (range=m) -> m /// Represents the right hand side of an exception definition in a signature file [] diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 06a292dc66e..f53fec4bad9 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -659,7 +659,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = match ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap scopem true OpenQualified env.eNameResEnv ad id rest true with | Result modrefs -> let modrefs = List.map p23 modrefs - let openTarget = SynOpenDeclTarget.ModuleOrNamespace(enclosingNamespacePathToOpen) + let openTarget = SynOpenDeclTarget.ModuleOrNamespace(enclosingNamespacePathToOpen, scopem) let openDecl = OpenDeclaration.Create (openTarget, modrefs, [], scopem, true) OpenEntities tcSink g amap scopem false env modrefs openDecl | Exception _ -> env @@ -3635,7 +3635,7 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = // Mutually recursive shapes //------------------------------------------------------------------------- -type MutRecDataForOpen = MutRecDataForOpen of SynOpenDeclTarget * range * appliedScope: range +type MutRecDataForOpen = MutRecDataForOpen of SynOpenDeclTarget * appliedScope: range type MutRecDataForModuleAbbrev = MutRecDataForModuleAbbrev of Ident * LongIdent * range /// Represents the shape of a mutually recursive group of declarations including nested modules @@ -13007,7 +13007,7 @@ let TcOpenModuleOrNamespaceDecl tcSink g amap m scopem env (longId: Ident list) let modrefs = List.map p23 modrefs modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult) - let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.ModuleOrNamespace longId, modrefs, [], scopem, false) + let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.ModuleOrNamespace (longId, m), modrefs, [], scopem, false) let env = OpenEntities tcSink g amap scopem false env modrefs openDecl env @@ -13017,14 +13017,14 @@ let TcOpenTypeDecl (cenv: cenv) m scopem env (synType: SynType) = checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration m let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType - let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type synType, [], [typ], scopem, false) + let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type (synType, m), [], [typ], scopem, false) let env = OpenTypeStaticContent cenv.tcSink g cenv.amap scopem env typ openDecl env -let TcOpenDecl cenv m scopem env (content: SynOpenDeclTarget) = - match content with - | SynOpenDeclTarget.ModuleOrNamespace (longId) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m scopem env longId - | SynOpenDeclTarget.Type synType -> TcOpenTypeDecl cenv m scopem env synType +let TcOpenDecl cenv scopem env target = + match target with + | SynOpenDeclTarget.ModuleOrNamespace (longId, m) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m scopem env longId + | SynOpenDeclTarget.Type (synType, m) -> TcOpenTypeDecl cenv m scopem env synType exception ParameterlessStructCtor of range @@ -14257,8 +14257,8 @@ module MutRecBindingChecking = #if OPEN_IN_TYPE_DECLARATIONS | Phase2AOpen(target, m) -> - let envInstance = TcOpenDecl cenv m scopem envInstance target - let envStatic = TcOpenDecl cenv m scopem envStatic target + let envInstance = TcOpenDecl cenv scopem envInstance target + let envStatic = TcOpenDecl cenv scopem envStatic target let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BOpen, innerState #endif @@ -14539,7 +14539,7 @@ module MutRecBindingChecking = let tycons = decls |> List.choose (function MutRecShape.Tycon d -> getTyconOpt d | _ -> None) let mspecs = decls |> List.choose (function MutRecShape.Module (MutRecDefnsPhase2DataForModule (_, mspec), _) -> Some mspec | _ -> None) let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) - let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (target, m, moduleRange)) -> Some (target, m, moduleRange) | _ -> None) + let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (target, moduleRange)) -> Some (target, moduleRange) | _ -> None) let lets = decls |> List.collect (function MutRecShape.Lets binds -> getVals binds | _ -> []) let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsExceptionDecl) @@ -14565,7 +14565,7 @@ module MutRecBindingChecking = // Add the modules being defined let envForDecls = (envForDecls, mspecs) ||> List.fold ((if report then AddLocalSubModuleAndReport cenv.tcSink scopem else AddLocalSubModule) cenv.g cenv.amap m) // Process the 'open' declarations - let envForDecls = (envForDecls, opens) ||> List.fold (fun env (target, m, moduleRange) -> TcOpenDecl cenv m moduleRange env target) + let envForDecls = (envForDecls, opens) ||> List.fold (fun env (target, moduleRange) -> TcOpenDecl cenv moduleRange env target) // Add the type definitions being defined let envForDecls = (if report then AddLocalTyconsAndReport cenv.tcSink scopem else AddLocalTycons) cenv.g cenv.amap m tycons envForDecls // Add the exception definitions being defined @@ -17324,7 +17324,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS | SynModuleSigDecl.Open (target, m) -> let scopem = unionRanges m.EndRange endm - let env = TcOpenDecl cenv m scopem env target + let env = TcOpenDecl cenv scopem env target return env | SynModuleSigDecl.Val (vspec, m) -> @@ -17489,7 +17489,7 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d | SynModuleSigDecl.Open (target, m) -> if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) - let decls = [ MutRecShape.Open (MutRecDataForOpen(target, m, moduleRange)) ] + let decls = [ MutRecShape.Open (MutRecDataForOpen(target, moduleRange)) ] decls, (openOk, moduleAbbrevOk) | SynModuleSigDecl.Exception (SynExceptionSig(exnRepr, members, _), _) -> @@ -17618,7 +17618,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem | SynModuleDecl.Open (target, m) -> let scopem = unionRanges m.EndRange scopem - let env = TcOpenDecl cenv m scopem env target + let env = TcOpenDecl cenv scopem env target return ((fun e -> e), []), env, env | SynModuleDecl.Let (letrec, binds, m) -> @@ -17820,7 +17820,7 @@ and TcModuleOrNamespaceElementsMutRec cenv parent typeNames m envInitial mutRecN | SynModuleDecl.Open (target, m) -> if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) - let decls = [ MutRecShape.Open (MutRecDataForOpen(target, m, moduleRange)) ] + let decls = [ MutRecShape.Open (MutRecDataForOpen(target, moduleRange)) ] decls, (openOk, moduleAbbrevOk, attrs) | SynModuleDecl.Exception (SynExceptionDefn(repr, members, _), _m) -> @@ -17923,7 +17923,7 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env match modref.TryDeref with | ValueNone -> warn() | ValueSome _ -> - let openTarget = SynOpenDeclTarget.ModuleOrNamespace([]) + let openTarget = SynOpenDeclTarget.ModuleOrNamespace([], scopem) let openDecl = OpenDeclaration.Create (openTarget, [modref], [], scopem, false) OpenEntities TcResultsSink.NoSink g amap scopem root env [modref] openDecl diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 531f7290a5b..00bc5eadb9e 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -1266,10 +1266,10 @@ moduleDefn: openDecl: /* 'open' declarations */ | OPEN path - { SynOpenDeclTarget.ModuleOrNamespace $2.Lid } + { SynOpenDeclTarget.ModuleOrNamespace($2.Lid, (rhs parseState 2)) } | OPEN typeKeyword appType - { SynOpenDeclTarget.Type $3 } + { SynOpenDeclTarget.Type($3, (rhs parseState 3)) } /* The right-hand-side of a module abbreviation definition */ /* This occurs on the right of a module abbreviation (#light encloses the r.h.s. with OBLOCKBEGIN/OBLOCKEND) */ From 3b37aa891788e897cc7588925c1f693c31409001 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 04:49:38 -0700 Subject: [PATCH 19/89] Fixing build --- src/fsharp/NameResolution.fs | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 61a0236f00e..6241270b34c 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1503,14 +1503,8 @@ type OpenDeclaration = { Target = target Range = match target with - | SynOpenDeclTarget.ModuleOrNamespace(longId) -> - match longId with - | [] -> None - | first :: rest -> - let last = rest |> List.tryLast |> Option.defaultValue first - Some (mkRange appliedScope.FileName first.idRange.Start last.idRange.End) - | SynOpenDeclTarget.Type(synType) -> - Some synType.Range + | SynOpenDeclTarget.ModuleOrNamespace (range=m) + | SynOpenDeclTarget.Type (range=m) -> Some m Types = types Modules = modules AppliedScope = appliedScope From 7d0a5c3520fd34959adf229ddb741a846365968d Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 04:52:01 -0700 Subject: [PATCH 20/89] Fixing build --- src/fsharp/symbols/Symbols.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index fbc4eb936b7..12dafff6f18 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -2505,8 +2505,8 @@ type FSharpOpenDeclaration(target: SynOpenDeclTarget, range: range option, modul member __.LongId = match target with - | SynOpenDeclTarget.ModuleOrNamespace(longId) -> longId - | SynOpenDeclTarget.Type(synType) -> + | SynOpenDeclTarget.ModuleOrNamespace(longId, _) -> longId + | SynOpenDeclTarget.Type(synType, _) -> let rec get ty = match ty with | SynType.LongIdent (LongIdentWithDots(lid, _)) -> lid From 7169f9f9686164019c49a0a3cb8e5719d51a174b Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 04:55:08 -0700 Subject: [PATCH 21/89] Fixing build --- tests/service/InteractiveCheckerTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index a1fe720339f..90328a73d8f 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -42,7 +42,7 @@ let internal identsAndRanges (input: ParsedInput) = | SynModuleDecl.Let(_, _, _) -> failwith "Not implemented yet" | SynModuleDecl.DoExpr(_, _, _range) -> failwith "Not implemented yet" | SynModuleDecl.Exception(_, _range) -> failwith "Not implemented yet" - | SynModuleDecl.Open(SynOpenDeclTarget.ModuleOrNamespace lid, range) -> [ identAndRange (longIdentToString lid) range ] + | SynModuleDecl.Open(SynOpenDeclTarget.ModuleOrNamespace (lid, range), _) -> [ identAndRange (longIdentToString lid) range ] | SynModuleDecl.Open(SynOpenDeclTarget.Type _, _) -> failwith "Not implemented yet" | SynModuleDecl.Attributes(_attrs, _range) -> failwith "Not implemented yet" | SynModuleDecl.HashDirective(_, _range) -> failwith "Not implemented yet" From 022a25beb68bd08b63d41f2cd88e3b1accf52907 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 06:01:17 -0700 Subject: [PATCH 22/89] Error if not an appty --- src/fsharp/NameResolution.fs | 8 ++++---- src/fsharp/NameResolution.fsi | 4 ++-- src/fsharp/TypeChecker.fs | 16 ++++++++++++---- 3 files changed, 18 insertions(+), 10 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 6241270b34c..98421be7a55 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1058,7 +1058,7 @@ let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, che GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty |> List.map (fun (tcref, tinst) -> MakeNestedType ncenv tinst m tcref) -let rec AddStaticContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = +let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) let items = @@ -1166,7 +1166,7 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true then if tcref.Typars(m).Length > 0 then failwith "nope" // TODO proper error let ty = generalizedTyconRef tcref - AddStaticContentOfTypeToNameEnv g amap ad m nenv ty + AddContentOfTypeToNameEnv g amap ad m nenv ty else nenv @@ -1295,10 +1295,10 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai and AddEntitiesContentsToNameEnv g amap ad m root nenv modrefs = (modrefs, nenv) ||> List.foldBack (fun modref acc -> AddEntityContentsToNameEnv g amap ad m root acc modref) -and AddTypeStaticContentsToNameEnv g amap ad m nenv (typ: TType) = +and AddTypeContentsToNameEnv g amap ad m nenv (typ: TType) = assert (isAppTy g typ) assert not (tcrefOfAppTy g typ).IsModuleOrNamespace - AddStaticContentOfTypeToNameEnv g amap ad m nenv typ + AddContentOfTypeToNameEnv g amap ad m nenv typ and AddEntityContentsToNameEnv g amap ad m root nenv (modref: EntityRef) = assert modref.IsModuleOrNamespace diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index bef74c265f1..bb68b3bc8a9 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -247,8 +247,8 @@ val internal AddModuleOrNamespaceRefToNameEnv : TcGlobals -> /// Add a list of modules or namespaces to the name resolution environment val internal AddEntitiesContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> ModuleOrNamespaceRef list -> NameResolutionEnv -/// Add the static content of a type to the name resolution environment -val internal AddTypeStaticContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> NameResolutionEnv -> TType -> NameResolutionEnv +/// Add the content of a type to the name resolution environment +val internal AddTypeContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> NameResolutionEnv -> TType -> NameResolutionEnv /// A flag which indicates if it is an error to have two declared type parameters with identical names /// in the name resolution environment. diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index f53fec4bad9..de728b2096f 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -383,10 +383,10 @@ let OpenEntities tcSink g amap scopem root env mvvs openDeclaration = CallOpenDeclarationSink tcSink openDeclaration env -/// Adjust the TcEnv to account for opening the set of modules, namespaces or static classes implied by an `open` declaration -let OpenTypeStaticContent tcSink g amap scopem env (typ: TType) openDeclaration = +/// Adjust the TcEnv to account for opening the set of modules, namespaces or types implied by an `open` declaration +let OpenTypeContent tcSink g amap scopem env (typ: TType) openDeclaration = let env = - { env with eNameResEnv = AddTypeStaticContentsToNameEnv g amap env.eAccessRights scopem env.eNameResEnv typ } + { env with eNameResEnv = AddTypeContentsToNameEnv g amap env.eAccessRights scopem env.eNameResEnv typ } CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) CallOpenDeclarationSink tcSink openDeclaration env @@ -13017,8 +13017,16 @@ let TcOpenTypeDecl (cenv: cenv) m scopem env (synType: SynType) = checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration m let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType + + if not (isAppTy g typ) then + error(Error(FSComp.SR.tcNamedTypeRequired(FSComp.SR.featureOpenTypeDeclaration()), m)) + + if isByrefTy g typ then + // TODO: Better error. + error(Error(FSComp.SR.tcByrefsMayNotHaveTypeExtensions(), m)) + let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type (synType, m), [], [typ], scopem, false) - let env = OpenTypeStaticContent cenv.tcSink g cenv.amap scopem env typ openDecl + let env = OpenTypeContent cenv.tcSink g cenv.amap scopem env typ openDecl env let TcOpenDecl cenv scopem env target = From 0307cb8c3b44c2563fd6182485ad531a6ef13246 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 06:03:43 -0700 Subject: [PATCH 23/89] Slightly better error --- src/fsharp/TypeChecker.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index de728b2096f..bd39a312849 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -13019,7 +13019,7 @@ let TcOpenTypeDecl (cenv: cenv) m scopem env (synType: SynType) = let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType if not (isAppTy g typ) then - error(Error(FSComp.SR.tcNamedTypeRequired(FSComp.SR.featureOpenTypeDeclaration()), m)) + error(Error(FSComp.SR.tcNamedTypeRequired("open type"), m)) if isByrefTy g typ then // TODO: Better error. From ad5734ebf8f205dab8c4ace7981142f454338d1d Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 12:36:04 -0700 Subject: [PATCH 24/89] Getting tests to pass --- src/fsharp/CompileOps.fs | 8 ++++---- src/fsharp/TypeChecker.fs | 36 ++++++++++++++++++------------------ src/fsharp/TypeChecker.fsi | 2 +- 3 files changed, 23 insertions(+), 23 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 0272d1204a7..c0868025e03 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -5580,7 +5580,7 @@ let GetInitialTcEnv (thisAssemblyName: string, initm: range, tcConfig: TcConfig, let tcEnv = CreateInitialTcEnv(tcGlobals, amap, initm, thisAssemblyName, ccus) if tcConfig.checkOverflow then - try TcOpenModuleOrNamespaceDecl TcResultsSink.NoSink tcGlobals amap initm initm tcEnv (pathToSynLid initm (splitNamespace FSharpLib.CoreOperatorsCheckedName)) + try TcOpenModuleOrNamespaceDecl TcResultsSink.NoSink tcGlobals amap initm tcEnv (pathToSynLid initm (splitNamespace FSharpLib.CoreOperatorsCheckedName), initm) with e -> errorRecovery e initm; tcEnv else tcEnv @@ -5737,7 +5737,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: | None -> tcEnv | Some prefixPath -> let m = qualNameOfFile.Range - TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m m tcEnv prefixPath + TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcEnv (prefixPath, m) let tcState = { tcState with @@ -5785,13 +5785,13 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: // Open the prefixPath for fsi.exe (tcImplEnv) let tcImplEnv = match prefixPathOpt with - | Some prefixPath -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m m tcImplEnv prefixPath + | Some prefixPath -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcImplEnv (prefixPath, m) | _ -> tcImplEnv // Open the prefixPath for fsi.exe (tcSigEnv) let tcSigEnv = match prefixPathOpt with - | Some prefixPath when not hadSig -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m m tcSigEnv prefixPath + | Some prefixPath when not hadSig -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcSigEnv (prefixPath, m) | _ -> tcSigEnv let ccuSig = CombineCcuContentFragments m [implFileSigType; tcState.tcsCcuSig ] diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index bd39a312849..9dfaa09ae1c 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3635,7 +3635,7 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = // Mutually recursive shapes //------------------------------------------------------------------------- -type MutRecDataForOpen = MutRecDataForOpen of SynOpenDeclTarget * appliedScope: range +type MutRecDataForOpen = MutRecDataForOpen of SynOpenDeclTarget * range * appliedScope: range type MutRecDataForModuleAbbrev = MutRecDataForModuleAbbrev of Ident * LongIdent * range /// Represents the shape of a mutually recursive group of declarations including nested modules @@ -6599,7 +6599,7 @@ and TcNewExpr cenv env tpenv objTy mObjTyOpt superInit arg mWholeExprOrObjTy = mkCallCreateInstance cenv.g mWholeExprOrObjTy objTy, tpenv else - if not (isAppTy cenv.g objTy) && not (isAnyTupleTy cenv.g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"), mWholeExprOrObjTy)) + if not (isAppTy cenv.g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"), mWholeExprOrObjTy)) let item = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mWholeExprOrObjTy ad objTy) TcCtorCall false cenv env tpenv objTy objTy mObjTyOpt item superInit [arg] mWholeExprOrObjTy [] None @@ -12955,7 +12955,7 @@ let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) = | Exception err -> errorR(err); [] -let TcOpenModuleOrNamespaceDecl tcSink g amap m scopem env (longId: Ident list) = +let TcOpenModuleOrNamespaceDecl tcSink g amap scopem env (longId, m) = match TcOpenLidAndPermitAutoResolve tcSink env amap longId with | [] -> env | modrefs -> @@ -13011,10 +13011,10 @@ let TcOpenModuleOrNamespaceDecl tcSink g amap m scopem env (longId: Ident list) let env = OpenEntities tcSink g amap scopem false env modrefs openDecl env -let TcOpenTypeDecl (cenv: cenv) m scopem env (synType: SynType) = +let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) = let g = cenv.g - checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration m + checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration mOpenDecl let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType @@ -13029,10 +13029,10 @@ let TcOpenTypeDecl (cenv: cenv) m scopem env (synType: SynType) = let env = OpenTypeContent cenv.tcSink g cenv.amap scopem env typ openDecl env -let TcOpenDecl cenv scopem env target = +let TcOpenDecl cenv mOpenDecl scopem env target = match target with - | SynOpenDeclTarget.ModuleOrNamespace (longId, m) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m scopem env longId - | SynOpenDeclTarget.Type (synType, m) -> TcOpenTypeDecl cenv m scopem env synType + | SynOpenDeclTarget.ModuleOrNamespace (longId, m) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap scopem env (longId, m) + | SynOpenDeclTarget.Type (synType, m) -> TcOpenTypeDecl cenv mOpenDecl scopem env (synType, m) exception ParameterlessStructCtor of range @@ -14265,8 +14265,8 @@ module MutRecBindingChecking = #if OPEN_IN_TYPE_DECLARATIONS | Phase2AOpen(target, m) -> - let envInstance = TcOpenDecl cenv scopem envInstance target - let envStatic = TcOpenDecl cenv scopem envStatic target + let envInstance = TcOpenDecl cenv m scopem envInstance target + let envStatic = TcOpenDecl cenv m scopem envStatic target let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BOpen, innerState #endif @@ -14547,7 +14547,7 @@ module MutRecBindingChecking = let tycons = decls |> List.choose (function MutRecShape.Tycon d -> getTyconOpt d | _ -> None) let mspecs = decls |> List.choose (function MutRecShape.Module (MutRecDefnsPhase2DataForModule (_, mspec), _) -> Some mspec | _ -> None) let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) - let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (target, moduleRange)) -> Some (target, moduleRange) | _ -> None) + let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (target, m, moduleRange)) -> Some (target, m, moduleRange) | _ -> None) let lets = decls |> List.collect (function MutRecShape.Lets binds -> getVals binds | _ -> []) let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsExceptionDecl) @@ -14573,7 +14573,7 @@ module MutRecBindingChecking = // Add the modules being defined let envForDecls = (envForDecls, mspecs) ||> List.fold ((if report then AddLocalSubModuleAndReport cenv.tcSink scopem else AddLocalSubModule) cenv.g cenv.amap m) // Process the 'open' declarations - let envForDecls = (envForDecls, opens) ||> List.fold (fun env (target, moduleRange) -> TcOpenDecl cenv moduleRange env target) + let envForDecls = (envForDecls, opens) ||> List.fold (fun env (target, m, moduleRange) -> TcOpenDecl cenv m moduleRange env target) // Add the type definitions being defined let envForDecls = (if report then AddLocalTyconsAndReport cenv.tcSink scopem else AddLocalTycons) cenv.g cenv.amap m tycons envForDecls // Add the exception definitions being defined @@ -17332,7 +17332,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS | SynModuleSigDecl.Open (target, m) -> let scopem = unionRanges m.EndRange endm - let env = TcOpenDecl cenv scopem env target + let env = TcOpenDecl cenv m scopem env target return env | SynModuleSigDecl.Val (vspec, m) -> @@ -17450,7 +17450,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment. let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p, _) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m.EndRange env ([p], m.EndRange) | None -> env // Publish the combined module type @@ -17497,7 +17497,7 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d | SynModuleSigDecl.Open (target, m) -> if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) - let decls = [ MutRecShape.Open (MutRecDataForOpen(target, moduleRange)) ] + let decls = [ MutRecShape.Open (MutRecDataForOpen(target, m, moduleRange)) ] decls, (openOk, moduleAbbrevOk) | SynModuleSigDecl.Exception (SynExceptionSig(exnRepr, members, _), _) -> @@ -17626,7 +17626,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem | SynModuleDecl.Open (target, m) -> let scopem = unionRanges m.EndRange scopem - let env = TcOpenDecl cenv scopem env target + let env = TcOpenDecl cenv m scopem env target return ((fun e -> e), []), env, env | SynModuleDecl.Let (letrec, binds, m) -> @@ -17759,7 +17759,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p, _) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenModuleOrNamespaceDecl cenv.tcSink cenv.g cenv.amap m.EndRange env ([p], m.EndRange) | None -> env // Publish the combined module type @@ -17828,7 +17828,7 @@ and TcModuleOrNamespaceElementsMutRec cenv parent typeNames m envInitial mutRecN | SynModuleDecl.Open (target, m) -> if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) - let decls = [ MutRecShape.Open (MutRecDataForOpen(target, moduleRange)) ] + let decls = [ MutRecShape.Open (MutRecDataForOpen(target, m, moduleRange)) ] decls, (openOk, moduleAbbrevOk, attrs) | SynModuleDecl.Exception (SynExceptionDefn(repr, members, _), _m) -> diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index f9ba68911be..d7c79e45772 100644 --- a/src/fsharp/TypeChecker.fsi +++ b/src/fsharp/TypeChecker.fsi @@ -26,7 +26,7 @@ val AddCcuToTcEnv : TcGlobals * ImportMap * range * TcEnv * assemblyName: s val AddLocalRootModuleOrNamespace : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> TcEnv -> ModuleOrNamespaceType -> TcEnv val AddLocalVal : NameResolution.TcResultsSink -> scopem: range -> v: Val -> TcEnv -> TcEnv val AddLocalSubModule : TcGlobals -> ImportMap -> range -> TcEnv -> ModuleOrNamespace -> TcEnv -val TcOpenModuleOrNamespaceDecl: NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> range -> TcEnv -> LongIdent -> TcEnv +val TcOpenModuleOrNamespaceDecl: NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> TcEnv -> (LongIdent * range) -> TcEnv type TopAttribs = { mainMethodAttrs : Attribs; From eaca69232584e652970bbe30874eca67b66d7651 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 13:05:26 -0700 Subject: [PATCH 25/89] Trying to fix tests --- src/fsharp/service/ServiceAnalysis.fs | 7 +++---- tests/service/StructureTests.fs | 8 ++++---- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index a982b7f6782..05da87170b9 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -136,7 +136,7 @@ module UnusedOpens = match symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some _ when not f.IsInstanceMember -> true + | Some _ -> true | _ -> false | _ -> false) @@ -211,9 +211,8 @@ module UnusedOpens = match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - // Show namespaces, modules, openable types, and type abbreviations. - // We show type abbreviations because they may have nested types that could be accessed. - | Some entity when not f.IsInstanceMember -> + // Show namespaces, modules, and types. + | Some entity -> symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.RangeAlternate) | _ -> () | _ -> () diff --git a/tests/service/StructureTests.fs b/tests/service/StructureTests.fs index 028e05e4b34..8fc1fb6dc7b 100644 --- a/tests/service/StructureTests.fs +++ b/tests/service/StructureTests.fs @@ -226,13 +226,13 @@ open H open G open H """ - => [ (2, 5, 3, 6), (2, 5, 3, 6) + => [ (2, 0, 3, 6), (2, 0, 3, 6) (5, 0, 19, 17), (5, 8, 19, 17) - (8, 9, 9, 10), (8, 9, 9, 10) + (8, 4, 9, 10), (8, 4, 9, 10) (11, 4, 14, 17), (11, 12, 14, 17) (16, 4, 19, 17), (16, 12, 19, 17) - (17, 13, 18, 14), (17, 13, 18, 14) - (21, 5, 26, 6), (21, 5, 26, 6) ] + (17, 8, 18, 14), (17, 8, 18, 14) + (21, 0, 26, 6), (21, 0, 26, 6) ] [] let ``hash directives``() = From ea6f8f74f66573ba0253f20583b5fbbdfcdaf3fd Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 13:20:23 -0700 Subject: [PATCH 26/89] Get current tests to pass --- src/fsharp/service/ServiceAnalysis.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index 05da87170b9..4e4f6b74b5c 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -136,7 +136,7 @@ module UnusedOpens = match symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some _ -> true + | Some entity when entity.IsNamespace || entity.IsFSharpModule -> true | _ -> false | _ -> false) @@ -212,7 +212,7 @@ module UnusedOpens = | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with // Show namespaces, modules, and types. - | Some entity -> + | Some entity when entity.IsNamespace || entity.IsFSharpModule -> symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.RangeAlternate) | _ -> () | _ -> () From 830895105e5fddd58cc96213aed269e2c8abe321 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 18:09:41 -0700 Subject: [PATCH 27/89] Partial working unused opens --- src/fsharp/service/ServiceAnalysis.fs | 229 +++----------------------- src/fsharp/symbols/Symbols.fsi | 2 +- 2 files changed, 26 insertions(+), 205 deletions(-) diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index 4e4f6b74b5c..e98a9453b34 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -11,225 +11,46 @@ open FSharp.Compiler.AbstractIL.Internal.Library module UnusedOpens = - let symbolHash = HashIdentity.FromFunctions (fun (x: FSharpSymbol) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) + let entityHash = HashIdentity.FromFunctions (fun (_x: FSharpEntity) -> 0) (fun x y -> x.LogicalName = y.LogicalName) - /// Represents one namespace or module or type opened by an 'open' declaration - type OpenedModule(entity: FSharpEntity, isNestedAutoOpen: bool) = + let isOpenDeclarationUsed (openDeclaration: FSharpOpenDeclaration) (usedEntities: HashSet) = + openDeclaration.Modules |> List.exists usedEntities.Contains || + openDeclaration.Types |> List.exists (fun x -> x.HasTypeDefinition && usedEntities.Contains x.TypeDefinition) - /// Compute an indexed table of the set of symbols revealed by 'open', on-demand - let revealedSymbols : Lazy> = - lazy - let symbols = - [| for ent in entity.NestedEntities do - yield ent :> FSharpSymbol - - if ent.IsFSharpRecord then - for rf in ent.FSharpFields do - yield rf :> FSharpSymbol - - if ent.IsFSharpUnion && not (Symbol.hasAttribute ent.Attributes) then - for unionCase in ent.UnionCases do - yield unionCase :> FSharpSymbol - - if Symbol.hasAttribute ent.Attributes then - for fv in ent.MembersFunctionsAndValues do - // fv.IsExtensionMember is always false for C# extension methods returning by `MembersFunctionsAndValues`, - // so we have to check Extension attribute instead. - // (note: fv.IsExtensionMember has proper value for symbols returning by GetAllUsesOfAllSymbolsInFile though) - if Symbol.hasAttribute fv.Attributes then - yield fv :> FSharpSymbol - - for apCase in entity.ActivePatternCases do - yield apCase :> FSharpSymbol - - // The IsNamespace and IsFSharpModule cases are handled by looking at DeclaringEntity below - if not entity.IsNamespace && not entity.IsFSharpModule then - for fv in entity.MembersFunctionsAndValues do - yield fv :> FSharpSymbol |] - - HashSet<_>(symbols, symbolHash) - - member __.Entity = entity - member __.IsNestedAutoOpen = isNestedAutoOpen - member __.RevealedSymbolsContains(symbol) = revealedSymbols.Force().Contains symbol - - type OpenedModuleGroup = - { OpenedModules: OpenedModule list } - - static member Create (modul: FSharpEntity) = - let rec getModuleAndItsAutoOpens (isNestedAutoOpen: bool) (modul: FSharpEntity) = - [ yield OpenedModule (modul, isNestedAutoOpen) - for ent in modul.NestedEntities do - if (not ent.IsNamespace) && Symbol.hasAttribute ent.Attributes then - yield! getModuleAndItsAutoOpens true ent ] - { OpenedModules = getModuleAndItsAutoOpens false modul } - - /// Represents single open statement. - type OpenStatement = - { /// All namespaces and modules which this open declaration effectively opens, including the AutoOpen ones - OpenedGroups: OpenedModuleGroup list - - /// The range of open statement itself - Range: range - - /// The scope on which this open declaration is applied - AppliedScope: range } - - /// Gets the open statements, their scopes and their resolutions - let getOpenStatements (openDeclarations: FSharpOpenDeclaration[]) : OpenStatement[] = - openDeclarations - |> Array.filter (fun x -> not x.IsOwnNamespace) - |> Array.choose (fun openDecl -> - match openDecl.LongId, openDecl.Range with - | firstId :: _, Some range -> - if firstId.idText = MangledGlobalName then - None - else - Some { OpenedGroups = openDecl.Modules |> List.map OpenedModuleGroup.Create - Range = range - AppliedScope = openDecl.AppliedScope } - | _ -> None) - - /// Only consider symbol uses which are the first part of a long ident, i.e. with no qualifying identifiers - let filterSymbolUses (getSourceLineStr: int -> string) (symbolUses: FSharpSymbolUse[]) : FSharpSymbolUse[] = - symbolUses - |> Array.filter (fun su -> - match su.Symbol with - | :? FSharpMemberOrFunctionOrValue as fv when fv.IsExtensionMember -> - // Extension members should be taken into account even though they have a prefix (as they do most of the time) - true - - | :? FSharpMemberOrFunctionOrValue as fv when not fv.IsModuleValueOrMember -> - // Local values can be ignored - false - - | :? FSharpMemberOrFunctionOrValue when su.IsFromDefinition -> - // Value definitions should be ignored - false - - | :? FSharpGenericParameter -> - // Generic parameters can be ignored, they never come into scope via 'open' - false - - | :? FSharpUnionCase when su.IsFromDefinition -> - false - - | :? FSharpField as field when - field.DeclaringEntity.IsSome && field.DeclaringEntity.Value.IsFSharpRecord -> - // Record fields are used in name resolution - true - - | :? FSharpField as field when field.IsUnionCaseField -> - false - - | _ -> - // For the rest of symbols we pick only those which are the first part of a long ident, because it's they which are - // contained in opened namespaces / modules. For example, we pick `IO` from long ident `IO.File.OpenWrite` because - // it's `open System` which really brings it into scope. - let partialName = QuickParse.GetPartialLongNameEx (getSourceLineStr su.RangeAlternate.StartLine, su.RangeAlternate.EndColumn - 1) - List.isEmpty partialName.QualifyingIdents) - - /// Split symbol uses into cases that are easy to handle (via DeclaringEntity) and those that don't have a good DeclaringEntity - let splitSymbolUses (symbolUses: FSharpSymbolUse[]) : FSharpSymbolUse[] * FSharpSymbolUse[] = - symbolUses |> Array.partition (fun symbolUse -> - let symbol = symbolUse.Symbol - match symbol with - | :? FSharpMemberOrFunctionOrValue as f -> - match f.DeclaringEntity with - | Some entity when entity.IsNamespace || entity.IsFSharpModule -> true - | _ -> false - | _ -> false) - - /// Given an 'open' statement, find fresh modules/namespaces referred to by that statement where there is some use of a revealed symbol - /// in the scope of the 'open' is from that module. - /// - /// Performance will be roughly NumberOfOpenStatements x NumberOfSymbolUses - let isOpenStatementUsed (symbolUses2: FSharpSymbolUse[]) (symbolUsesRangesByDeclaringEntity: Dictionary) - (usedModules: Dictionary) (openStatement: OpenStatement) = - - // Don't re-check modules whose symbols are already known to have been used - let openedGroupsToExamine = - openStatement.OpenedGroups |> List.choose (fun openedGroup -> - let openedEntitiesToExamine = - openedGroup.OpenedModules - |> List.filter (fun openedEntity -> - not (usedModules.BagExistsValueForKey(openedEntity.Entity, fun scope -> rangeContainsRange scope openStatement.AppliedScope))) - - match openedEntitiesToExamine with - | [] -> None - | _ when openedEntitiesToExamine |> List.exists (fun x -> not x.IsNestedAutoOpen) -> Some { OpenedModules = openedEntitiesToExamine } - | _ -> None) - - // Find the opened groups that are used by some symbol use - let newlyUsedOpenedGroups = - openedGroupsToExamine |> List.filter (fun openedGroup -> - openedGroup.OpenedModules |> List.exists (fun openedEntity -> - symbolUsesRangesByDeclaringEntity.BagExistsValueForKey(openedEntity.Entity, fun symbolUseRange -> - rangeContainsRange openStatement.AppliedScope symbolUseRange && - Range.posGt symbolUseRange.Start openStatement.Range.End) || - - symbolUses2 |> Array.exists (fun symbolUse -> - rangeContainsRange openStatement.AppliedScope symbolUse.RangeAlternate && - Range.posGt symbolUse.RangeAlternate.Start openStatement.Range.End && - openedEntity.RevealedSymbolsContains symbolUse.Symbol))) - - // Return them as interim used entities - let newlyOpenedModules = newlyUsedOpenedGroups |> List.collect (fun openedGroup -> openedGroup.OpenedModules) - for openedModule in newlyOpenedModules do - let scopes = - match usedModules.TryGetValue openedModule.Entity with - | true, scopes -> openStatement.AppliedScope :: scopes - | _ -> [openStatement.AppliedScope] - usedModules.[openedModule.Entity] <- scopes - not (isNil newlyOpenedModules) - - /// Incrementally filter out the open statements one by one. Filter those whose contents are referred to somewhere in the symbol uses. - /// Async to allow cancellation. - let rec filterOpenStatementsIncremental symbolUses2 (symbolUsesRangesByDeclaringEntity: Dictionary) (openStatements: OpenStatement list) - (usedModules: Dictionary) acc = - async { - match openStatements with - | openStatement :: rest -> - if isOpenStatementUsed symbolUses2 symbolUsesRangesByDeclaringEntity usedModules openStatement then - return! filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity rest usedModules acc - else - // The open statement has not been used, include it in the results - return! filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity rest usedModules (openStatement :: acc) - | [] -> return List.rev acc - } - - let entityHash = HashIdentity.FromFunctions (fun (x: FSharpEntity) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) - - /// Filter out the open statements whose contents are referred to somewhere in the symbol uses. - /// Async to allow cancellation. - let filterOpenStatements (symbolUses1: FSharpSymbolUse[], symbolUses2: FSharpSymbolUse[]) openStatements = + let filterOpenStatements (symbolUses: FSharpSymbolUse seq) (openDeclarations: FSharpOpenDeclaration seq) = async { - // the key is a namespace or module or type, the value is a list of FSharpSymbolUse range of symbols defined in the - // namespace or module or type. So, it's just symbol uses ranges grouped by namespace or module where they are _defined_. - let symbolUsesRangesByDeclaringEntity = Dictionary(entityHash) - for symbolUse in symbolUses1 do + let usedEntities = HashSet entityHash + + for symbolUse in symbolUses do match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - // Show namespaces, modules, and types. - | Some entity when entity.IsNamespace || entity.IsFSharpModule -> - symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.RangeAlternate) + | Some entity when entity.IsFSharpModule -> + usedEntities.Add entity |> ignore + | Some entity -> + match entity.DeclaringEntity with + | Some entity2 -> + usedEntities.Add entity2 |> ignore + | _ -> () | _ -> () | _ -> () - let! results = filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity (List.ofArray openStatements) (Dictionary(entityHash)) [] - return results |> List.map (fun os -> os.Range) + + return + [ for x in openDeclarations do + match x.Range with + | None -> () + | Some r -> + if not (isOpenDeclarationUsed x usedEntities) then + yield r ] } /// Get the open statements whose contents are not referred to anywhere in the symbol uses. /// Async to allow cancellation. - let getUnusedOpens (checkFileResults: FSharpCheckFileResults, getSourceLineStr: int -> string) : Async = + let getUnusedOpens (checkFileResults: FSharpCheckFileResults, _getSourceLineStr: int -> string) : Async = async { let! symbolUses = checkFileResults.GetAllUsesOfAllSymbolsInFile() - let symbolUses = filterSymbolUses getSourceLineStr symbolUses - let symbolUses = splitSymbolUses symbolUses - let openStatements = getOpenStatements checkFileResults.OpenDeclarations - return! filterOpenStatements symbolUses openStatements + return! filterOpenStatements symbolUses checkFileResults.OpenDeclarations } module SimplifyNames = diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 23736fcb832..1e088f3994d 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -1065,7 +1065,7 @@ type public FSharpOpenDeclaration = /// Modules or namespaces which is opened with this declaration. member Modules: FSharpEntity list - /// Types whose static content is opened with this declaration. + /// Types whose static members and nested types is opened with this declaration. member Types: FSharpType list /// Scope in which open declaration is visible. From faaec18edb672b5d098c8e8ef9a6312ad69e26b7 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 29 Jun 2020 18:49:29 -0700 Subject: [PATCH 28/89] Almost there --- src/fsharp/service/ServiceAnalysis.fs | 45 ++++++++++++++------------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index e98a9453b34..36d3d5e25fc 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -13,35 +13,38 @@ module UnusedOpens = let entityHash = HashIdentity.FromFunctions (fun (_x: FSharpEntity) -> 0) (fun x y -> x.LogicalName = y.LogicalName) - let isOpenDeclarationUsed (openDeclaration: FSharpOpenDeclaration) (usedEntities: HashSet) = - openDeclaration.Modules |> List.exists usedEntities.Contains || - openDeclaration.Types |> List.exists (fun x -> x.HasTypeDefinition && usedEntities.Contains x.TypeDefinition) + let rec isOpenEntityUsedByEntity (openEntity: FSharpEntity) (entity: FSharpEntity) = + openEntity.LogicalName = entity.LogicalName || + match entity.DeclaringEntity with + | Some declaringEntity -> isOpenEntityUsedByEntity openEntity declaringEntity + | _ -> false + + let isOpenEntityUsedBySymbol (openEntity: FSharpEntity) (symbol: FSharpSymbol) = + match symbol with + | :? FSharpMemberOrFunctionOrValue as f -> + match f.DeclaringEntity with + | Some entity -> isOpenEntityUsedByEntity openEntity entity + | _ -> false + | :? FSharpEntity as entity -> isOpenEntityUsedByEntity openEntity entity + | _ -> false + + let isOpenDeclarationUsed (openDeclaration: FSharpOpenDeclaration) (symbolUses: FSharpSymbolUse seq) = + symbolUses + |> Seq.exists (fun symbolUse -> + if Range.rangeContainsRange openDeclaration.AppliedScope symbolUse.RangeAlternate then + openDeclaration.Modules |> List.exists (fun x -> isOpenEntityUsedBySymbol x symbolUse.Symbol) || + openDeclaration.Types |> List.exists (fun x -> x.HasTypeDefinition && isOpenEntityUsedBySymbol x.TypeDefinition symbolUse.Symbol) + else + false) let filterOpenStatements (symbolUses: FSharpSymbolUse seq) (openDeclarations: FSharpOpenDeclaration seq) = async { - let usedEntities = HashSet entityHash - - for symbolUse in symbolUses do - match symbolUse.Symbol with - | :? FSharpMemberOrFunctionOrValue as f -> - match f.DeclaringEntity with - | Some entity when entity.IsFSharpModule -> - usedEntities.Add entity |> ignore - | Some entity -> - match entity.DeclaringEntity with - | Some entity2 -> - usedEntities.Add entity2 |> ignore - | _ -> () - | _ -> () - | _ -> () - - return [ for x in openDeclarations do match x.Range with | None -> () | Some r -> - if not (isOpenDeclarationUsed x usedEntities) then + if not (isOpenDeclarationUsed x symbolUses) then yield r ] } From df81cf5019bd5376b2ba67f54540e463c123fb7a Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 03:36:12 -0700 Subject: [PATCH 29/89] Some fixed --- src/fsharp/service/ServiceAnalysis.fs | 32 +++++++++++++++------------ 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index 36d3d5e25fc..64fa83557b4 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -11,33 +11,37 @@ open FSharp.Compiler.AbstractIL.Internal.Library module UnusedOpens = - let entityHash = HashIdentity.FromFunctions (fun (_x: FSharpEntity) -> 0) (fun x y -> x.LogicalName = y.LogicalName) - - let rec isOpenEntityUsedByEntity (openEntity: FSharpEntity) (entity: FSharpEntity) = - openEntity.LogicalName = entity.LogicalName || - match entity.DeclaringEntity with - | Some declaringEntity -> isOpenEntityUsedByEntity openEntity declaringEntity - | _ -> false + let rec isOpenEntityUsedByEntity first (openEntity: FSharpEntity) (entity: FSharpEntity) = + let isEqual = openEntity.Equals entity + if not isEqual && (first || Symbol.hasAttribute entity.Attributes) then + match entity.DeclaringEntity with + | Some entity -> isOpenEntityUsedByEntity false openEntity entity + | _ -> false + else + isEqual let isOpenEntityUsedBySymbol (openEntity: FSharpEntity) (symbol: FSharpSymbol) = match symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some entity -> isOpenEntityUsedByEntity openEntity entity + | Some entity -> isOpenEntityUsedByEntity true openEntity entity + | _ -> false + | :? FSharpEntity as entity -> + match entity.DeclaringEntity with + | Some entity -> isOpenEntityUsedByEntity false openEntity entity | _ -> false - | :? FSharpEntity as entity -> isOpenEntityUsedByEntity openEntity entity | _ -> false - let isOpenDeclarationUsed (openDeclaration: FSharpOpenDeclaration) (symbolUses: FSharpSymbolUse seq) = + let isOpenDeclarationUsed (openDeclaration: FSharpOpenDeclaration) (symbolUses: FSharpSymbolUse []) = symbolUses - |> Seq.exists (fun symbolUse -> - if Range.rangeContainsRange openDeclaration.AppliedScope symbolUse.RangeAlternate then + |> Array.exists (fun symbolUse -> + if not symbolUse.IsFromOpenStatement && Range.rangeContainsRange openDeclaration.AppliedScope symbolUse.RangeAlternate then openDeclaration.Modules |> List.exists (fun x -> isOpenEntityUsedBySymbol x symbolUse.Symbol) || openDeclaration.Types |> List.exists (fun x -> x.HasTypeDefinition && isOpenEntityUsedBySymbol x.TypeDefinition symbolUse.Symbol) else false) - let filterOpenStatements (symbolUses: FSharpSymbolUse seq) (openDeclarations: FSharpOpenDeclaration seq) = + let filterOpenStatements (symbolUses: FSharpSymbolUse []) (openDeclarations: FSharpOpenDeclaration []) = async { return [ for x in openDeclarations do @@ -45,7 +49,7 @@ module UnusedOpens = | None -> () | Some r -> if not (isOpenDeclarationUsed x symbolUses) then - yield r ] + r ] } /// Get the open statements whose contents are not referred to anywhere in the symbol uses. From 0858bebdb5b41f85af0b0bfe6a45fd82388cd488 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 09:43:10 -0700 Subject: [PATCH 30/89] Reverting back to original service analysis --- src/fsharp/service/ServiceAnalysis.fs | 249 ++++++++++++++++++++++---- 1 file changed, 210 insertions(+), 39 deletions(-) diff --git a/src/fsharp/service/ServiceAnalysis.fs b/src/fsharp/service/ServiceAnalysis.fs index 64fa83557b4..69d2d774669 100644 --- a/src/fsharp/service/ServiceAnalysis.fs +++ b/src/fsharp/service/ServiceAnalysis.fs @@ -11,53 +11,224 @@ open FSharp.Compiler.AbstractIL.Internal.Library module UnusedOpens = - let rec isOpenEntityUsedByEntity first (openEntity: FSharpEntity) (entity: FSharpEntity) = - let isEqual = openEntity.Equals entity - if not isEqual && (first || Symbol.hasAttribute entity.Attributes) then - match entity.DeclaringEntity with - | Some entity -> isOpenEntityUsedByEntity false openEntity entity - | _ -> false - else - isEqual - - let isOpenEntityUsedBySymbol (openEntity: FSharpEntity) (symbol: FSharpSymbol) = - match symbol with - | :? FSharpMemberOrFunctionOrValue as f -> - match f.DeclaringEntity with - | Some entity -> isOpenEntityUsedByEntity true openEntity entity - | _ -> false - | :? FSharpEntity as entity -> - match entity.DeclaringEntity with - | Some entity -> isOpenEntityUsedByEntity false openEntity entity - | _ -> false - | _ -> false - - let isOpenDeclarationUsed (openDeclaration: FSharpOpenDeclaration) (symbolUses: FSharpSymbolUse []) = + let symbolHash = HashIdentity.FromFunctions (fun (x: FSharpSymbol) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) + + /// Represents one namespace or module opened by an 'open' statement + type OpenedModule(entity: FSharpEntity, isNestedAutoOpen: bool) = + + /// Compute an indexed table of the set of symbols revealed by 'open', on-demand + let revealedSymbols : Lazy> = + lazy + let symbols = + [| for ent in entity.NestedEntities do + yield ent :> FSharpSymbol + + if ent.IsFSharpRecord then + for rf in ent.FSharpFields do + yield rf :> FSharpSymbol + + if ent.IsFSharpUnion && not (Symbol.hasAttribute ent.Attributes) then + for unionCase in ent.UnionCases do + yield unionCase :> FSharpSymbol + + if Symbol.hasAttribute ent.Attributes then + for fv in ent.MembersFunctionsAndValues do + // fv.IsExtensionMember is always false for C# extension methods returning by `MembersFunctionsAndValues`, + // so we have to check Extension attribute instead. + // (note: fv.IsExtensionMember has proper value for symbols returning by GetAllUsesOfAllSymbolsInFile though) + if Symbol.hasAttribute fv.Attributes then + yield fv :> FSharpSymbol + + for apCase in entity.ActivePatternCases do + yield apCase :> FSharpSymbol + + // The IsNamespace and IsFSharpModule cases are handled by looking at DeclaringEntity below + if not entity.IsNamespace && not entity.IsFSharpModule then + for fv in entity.MembersFunctionsAndValues do + yield fv :> FSharpSymbol |] + + HashSet<_>(symbols, symbolHash) + + member __.Entity = entity + member __.IsNestedAutoOpen = isNestedAutoOpen + member __.RevealedSymbolsContains(symbol) = revealedSymbols.Force().Contains symbol + + type OpenedModuleGroup = + { OpenedModules: OpenedModule list } + + static member Create (modul: FSharpEntity) = + let rec getModuleAndItsAutoOpens (isNestedAutoOpen: bool) (modul: FSharpEntity) = + [ yield OpenedModule (modul, isNestedAutoOpen) + for ent in modul.NestedEntities do + if ent.IsFSharpModule && Symbol.hasAttribute ent.Attributes then + yield! getModuleAndItsAutoOpens true ent ] + { OpenedModules = getModuleAndItsAutoOpens false modul } + + /// Represents single open statement. + type OpenStatement = + { /// All namespaces and modules which this open declaration effectively opens, including the AutoOpen ones + OpenedGroups: OpenedModuleGroup list + + /// The range of open statement itself + Range: range + + /// The scope on which this open declaration is applied + AppliedScope: range } + + /// Gets the open statements, their scopes and their resolutions + let getOpenStatements (openDeclarations: FSharpOpenDeclaration[]) : OpenStatement[] = + openDeclarations + |> Array.filter (fun x -> not x.IsOwnNamespace) + |> Array.choose (fun openDecl -> + match openDecl.LongId, openDecl.Range with + | firstId :: _, Some range -> + if firstId.idText = MangledGlobalName then + None + else + Some { OpenedGroups = openDecl.Modules |> List.map OpenedModuleGroup.Create + Range = range + AppliedScope = openDecl.AppliedScope } + | _ -> None) + + /// Only consider symbol uses which are the first part of a long ident, i.e. with no qualifying identifiers + let filterSymbolUses (getSourceLineStr: int -> string) (symbolUses: FSharpSymbolUse[]) : FSharpSymbolUse[] = symbolUses - |> Array.exists (fun symbolUse -> - if not symbolUse.IsFromOpenStatement && Range.rangeContainsRange openDeclaration.AppliedScope symbolUse.RangeAlternate then - openDeclaration.Modules |> List.exists (fun x -> isOpenEntityUsedBySymbol x symbolUse.Symbol) || - openDeclaration.Types |> List.exists (fun x -> x.HasTypeDefinition && isOpenEntityUsedBySymbol x.TypeDefinition symbolUse.Symbol) - else - false) - - let filterOpenStatements (symbolUses: FSharpSymbolUse []) (openDeclarations: FSharpOpenDeclaration []) = + |> Array.filter (fun su -> + match su.Symbol with + | :? FSharpMemberOrFunctionOrValue as fv when fv.IsExtensionMember -> + // Extension members should be taken into account even though they have a prefix (as they do most of the time) + true + + | :? FSharpMemberOrFunctionOrValue as fv when not fv.IsModuleValueOrMember -> + // Local values can be ignored + false + + | :? FSharpMemberOrFunctionOrValue when su.IsFromDefinition -> + // Value definitions should be ignored + false + + | :? FSharpGenericParameter -> + // Generic parameters can be ignored, they never come into scope via 'open' + false + + | :? FSharpUnionCase when su.IsFromDefinition -> + false + + | :? FSharpField as field when + field.DeclaringEntity.IsSome && field.DeclaringEntity.Value.IsFSharpRecord -> + // Record fields are used in name resolution + true + + | :? FSharpField as field when field.IsUnionCaseField -> + false + + | _ -> + // For the rest of symbols we pick only those which are the first part of a long ident, because it's they which are + // contained in opened namespaces / modules. For example, we pick `IO` from long ident `IO.File.OpenWrite` because + // it's `open System` which really brings it into scope. + let partialName = QuickParse.GetPartialLongNameEx (getSourceLineStr su.RangeAlternate.StartLine, su.RangeAlternate.EndColumn - 1) + List.isEmpty partialName.QualifyingIdents) + + /// Split symbol uses into cases that are easy to handle (via DeclaringEntity) and those that don't have a good DeclaringEntity + let splitSymbolUses (symbolUses: FSharpSymbolUse[]) : FSharpSymbolUse[] * FSharpSymbolUse[] = + symbolUses |> Array.partition (fun symbolUse -> + let symbol = symbolUse.Symbol + match symbol with + | :? FSharpMemberOrFunctionOrValue as f -> + match f.DeclaringEntity with + | Some ent when ent.IsNamespace || ent.IsFSharpModule -> true + | _ -> false + | _ -> false) + + /// Given an 'open' statement, find fresh modules/namespaces referred to by that statement where there is some use of a revealed symbol + /// in the scope of the 'open' is from that module. + /// + /// Performance will be roughly NumberOfOpenStatements x NumberOfSymbolUses + let isOpenStatementUsed (symbolUses2: FSharpSymbolUse[]) (symbolUsesRangesByDeclaringEntity: Dictionary) + (usedModules: Dictionary) (openStatement: OpenStatement) = + + // Don't re-check modules whose symbols are already known to have been used + let openedGroupsToExamine = + openStatement.OpenedGroups |> List.choose (fun openedGroup -> + let openedEntitiesToExamine = + openedGroup.OpenedModules + |> List.filter (fun openedEntity -> + not (usedModules.BagExistsValueForKey(openedEntity.Entity, fun scope -> rangeContainsRange scope openStatement.AppliedScope))) + + match openedEntitiesToExamine with + | [] -> None + | _ when openedEntitiesToExamine |> List.exists (fun x -> not x.IsNestedAutoOpen) -> Some { OpenedModules = openedEntitiesToExamine } + | _ -> None) + + // Find the opened groups that are used by some symbol use + let newlyUsedOpenedGroups = + openedGroupsToExamine |> List.filter (fun openedGroup -> + openedGroup.OpenedModules |> List.exists (fun openedEntity -> + symbolUsesRangesByDeclaringEntity.BagExistsValueForKey(openedEntity.Entity, fun symbolUseRange -> + rangeContainsRange openStatement.AppliedScope symbolUseRange && + Range.posGt symbolUseRange.Start openStatement.Range.End) || + + symbolUses2 |> Array.exists (fun symbolUse -> + rangeContainsRange openStatement.AppliedScope symbolUse.RangeAlternate && + Range.posGt symbolUse.RangeAlternate.Start openStatement.Range.End && + openedEntity.RevealedSymbolsContains symbolUse.Symbol))) + + // Return them as interim used entities + let newlyOpenedModules = newlyUsedOpenedGroups |> List.collect (fun openedGroup -> openedGroup.OpenedModules) + for openedModule in newlyOpenedModules do + let scopes = + match usedModules.TryGetValue openedModule.Entity with + | true, scopes -> openStatement.AppliedScope :: scopes + | _ -> [openStatement.AppliedScope] + usedModules.[openedModule.Entity] <- scopes + not (isNil newlyOpenedModules) + + /// Incrementally filter out the open statements one by one. Filter those whose contents are referred to somewhere in the symbol uses. + /// Async to allow cancellation. + let rec filterOpenStatementsIncremental symbolUses2 (symbolUsesRangesByDeclaringEntity: Dictionary) (openStatements: OpenStatement list) + (usedModules: Dictionary) acc = + async { + match openStatements with + | openStatement :: rest -> + if isOpenStatementUsed symbolUses2 symbolUsesRangesByDeclaringEntity usedModules openStatement then + return! filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity rest usedModules acc + else + // The open statement has not been used, include it in the results + return! filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity rest usedModules (openStatement :: acc) + | [] -> return List.rev acc + } + + let entityHash = HashIdentity.FromFunctions (fun (x: FSharpEntity) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) + + /// Filter out the open statements whose contents are referred to somewhere in the symbol uses. + /// Async to allow cancellation. + let filterOpenStatements (symbolUses1: FSharpSymbolUse[], symbolUses2: FSharpSymbolUse[]) openStatements = async { - return - [ for x in openDeclarations do - match x.Range with - | None -> () - | Some r -> - if not (isOpenDeclarationUsed x symbolUses) then - r ] + // the key is a namespace or module, the value is a list of FSharpSymbolUse range of symbols defined in the + // namespace or module. So, it's just symbol uses ranges grouped by namespace or module where they are _defined_. + let symbolUsesRangesByDeclaringEntity = Dictionary(entityHash) + for symbolUse in symbolUses1 do + match symbolUse.Symbol with + | :? FSharpMemberOrFunctionOrValue as f -> + match f.DeclaringEntity with + | Some entity when entity.IsNamespace || entity.IsFSharpModule -> + symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.RangeAlternate) + | _ -> () + | _ -> () + + let! results = filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity (List.ofArray openStatements) (Dictionary(entityHash)) [] + return results |> List.map (fun os -> os.Range) } /// Get the open statements whose contents are not referred to anywhere in the symbol uses. /// Async to allow cancellation. - let getUnusedOpens (checkFileResults: FSharpCheckFileResults, _getSourceLineStr: int -> string) : Async = + let getUnusedOpens (checkFileResults: FSharpCheckFileResults, getSourceLineStr: int -> string) : Async = async { let! symbolUses = checkFileResults.GetAllUsesOfAllSymbolsInFile() - return! filterOpenStatements symbolUses checkFileResults.OpenDeclarations + let symbolUses = filterSymbolUses getSourceLineStr symbolUses + let symbolUses = splitSymbolUses symbolUses + let openStatements = getOpenStatements checkFileResults.OpenDeclarations + return! filterOpenStatements symbolUses openStatements } module SimplifyNames = From bd76d23c94ce0fd6a6f0dcc2a9144414151885b8 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 11:56:16 -0700 Subject: [PATCH 31/89] Fixed test --- tests/service/ProjectAnalysisTests.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 0f26b4f166a..cd3a8164d1e 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -5568,7 +5568,7 @@ module Nested = |> List.ofSeq |> List.map(fun openDeclaration -> tups openDeclaration.AppliedScope) |> shouldEqual - [ (4, 5), (7, 15) + [ (4, 0), (7, 15) (6, 0), (7, 15) - (11, 5), (14, 15) + (11, 0), (14, 15) (13, 0), (14, 15) ] From a7cb900ba61992055d26b8337f5c66ebf35a3fbb Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 12:37:22 -0700 Subject: [PATCH 32/89] Fixed test --- src/fsharp/TypeChecker.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 9dfaa09ae1c..8b7cc26c640 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -6599,7 +6599,7 @@ and TcNewExpr cenv env tpenv objTy mObjTyOpt superInit arg mWholeExprOrObjTy = mkCallCreateInstance cenv.g mWholeExprOrObjTy objTy, tpenv else - if not (isAppTy cenv.g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"), mWholeExprOrObjTy)) + if not (isAppTy cenv.g objTy) && not (isAnyTupleTy cenv.g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"), mWholeExprOrObjTy)) let item = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mWholeExprOrObjTy ad objTy) TcCtorCall false cenv env tpenv objTy objTy mObjTyOpt item superInit [arg] mWholeExprOrObjTy [] None From 9fcdcf9bbdd99b306e15943d60c3f8cdd1e8c827 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 12:44:18 -0700 Subject: [PATCH 33/89] Fixed build --- src/fsharp/TypeChecker.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 8b7cc26c640..b4fde84190b 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -13868,7 +13868,7 @@ module MutRecBindingChecking = | Phase2AMember of PreCheckingRecursiveBinding #if OPEN_IN_TYPE_DECLARATIONS /// A dummy declaration, should we ever support 'open' in type definitions - | Phase2AOpen of LongIdent * isOpenType: bool * range + | Phase2AOpen of SynOpenDeclTarget * range #endif /// Indicates the super init has just been called, 'this' may now be published | Phase2AIncrClassCtorJustAfterSuperInit @@ -14050,9 +14050,9 @@ module MutRecBindingChecking = cbinds, innerState #if OPEN_IN_TYPE_DECLARATIONS - | SynMemberDefn.Open (mp, isOpenType, m), _ -> + | SynMemberDefn.Open (target, m), _ -> let innerState = (incrClassCtorLhsOpt, env, tpenv, recBindIdx, prelimRecValuesRev, uncheckedBindsRev) - [ Phase2AOpen (mp, isOpenType, m) ], innerState + [ Phase2AOpen (target, m) ], innerState #endif | definition -> From 561616fc95fb8a856d1b65d6f96daec2caad04b6 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 17:31:45 -0700 Subject: [PATCH 34/89] Fixing tests --- .../Tests.LanguageService.Completion.fs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index 0c1a9f7d371..b2021c65570 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs @@ -3909,8 +3909,8 @@ let x = query { for bbbb in abbbbc(*D0*) do AssertAutoCompleteContains [ "open System." ] "." // marker - [ "Collections"; "Console" ] // should contain (namespace, static type) - [ "Int32" ] // should not contain (non-static type) + [ "Collections" ] // should contain (namespace) + [ ] // should not contain [] member public this.``OpenNamespaceOrModule.CompletionOnlyContainsNamespaceOrModule.Case2``() = @@ -3920,6 +3920,13 @@ let x = query { for bbbb in abbbbc(*D0*) do [ "Parallel" ] // should contain (module) [ "map" ] // should not contain (let-bound value) + [] + member public this.``OpenTypeNamespaceOrModule.CompletionOnlyContainsNamespaceOrModule.Case1``() = + AssertAutoCompleteContains + [ "open type System." ] + "." // marker + [ "Collections"; "Console"; "Int32" ] // should contain (namespace and two types) + [] member public this.``BY_DESIGN.CommonScenarioThatBegsTheQuestion.Bug73940``() = AssertAutoCompleteContains From 110a37d574c61ea3ddb188e99ac00e3ceb811a48 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 20:15:22 -0700 Subject: [PATCH 35/89] Fixing tests --- .../Tests.LanguageService.Completion.fs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index b2021c65570..5eb35719d9a 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs @@ -3920,13 +3920,6 @@ let x = query { for bbbb in abbbbc(*D0*) do [ "Parallel" ] // should contain (module) [ "map" ] // should not contain (let-bound value) - [] - member public this.``OpenTypeNamespaceOrModule.CompletionOnlyContainsNamespaceOrModule.Case1``() = - AssertAutoCompleteContains - [ "open type System." ] - "." // marker - [ "Collections"; "Console"; "Int32" ] // should contain (namespace and two types) - [] member public this.``BY_DESIGN.CommonScenarioThatBegsTheQuestion.Bug73940``() = AssertAutoCompleteContains From 55129fcac8652281ce1dfdc9ef62c1397c374f49 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 20:22:55 -0700 Subject: [PATCH 36/89] Fixing more tests --- vsintegration/tests/UnitTests/CompletionProviderTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 97ea7cbeff8..c118426f4b2 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -447,7 +447,7 @@ List(). [] let ``Completion for open contains namespaces and static types``() = let fileContents = """ -open System.Ma +open type System.Ma """ let expected = ["Management"; "Math"] // both namespace and static type VerifyCompletionList(fileContents, "System.Ma", expected, []) From 27c48be090e6bfe87e88ce8540307ab8212bbd59 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 30 Jun 2020 21:36:51 -0700 Subject: [PATCH 37/89] Removing broken tests --- .../Tests.LanguageService.Completion.fs | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index 5eb35719d9a..ff5b4ddee17 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs @@ -3816,13 +3816,6 @@ let x = query { for bbbb in abbbbc(*D0*) do [] - member public this.``Attribute.WhenAttachedToNothing.Bug70080``() = - this.AutoCompleteBug70080Helper(@" - open System - [] member public this.``Attribute.WhenAttachedToLetInNamespace.Bug70080``() = this.AutoCompleteBug70080Helper @" @@ -5319,17 +5312,6 @@ let x = query { for bbbb in abbbbc(*D0*) do "[<" ["AttributeUsage"] [] - - [] - member this.``Attributes.CanSeeOpenNamespaces.Bug268290.Case2``() = - AssertCtrlSpaceCompleteContains - [""" - open System - [< - """] - "[<" - ["AttributeUsage"] - [] [] member this.``Selection``() = From 82c9002c5a1b23146d293a1e580935cd8a000c8b Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 8 Jul 2020 15:02:09 -0700 Subject: [PATCH 38/89] Added more tests. Checking for byrefs --- src/fsharp/FSComp.txt | 1 + src/fsharp/NameResolution.fs | 138 ++--- src/fsharp/TypeChecker.fs | 3 +- src/fsharp/xlf/FSComp.txt.cs.xlf | 5 + src/fsharp/xlf/FSComp.txt.de.xlf | 5 + src/fsharp/xlf/FSComp.txt.es.xlf | 5 + src/fsharp/xlf/FSComp.txt.fr.xlf | 5 + src/fsharp/xlf/FSComp.txt.it.xlf | 5 + src/fsharp/xlf/FSComp.txt.ja.xlf | 5 + src/fsharp/xlf/FSComp.txt.ko.xlf | 5 + src/fsharp/xlf/FSComp.txt.pl.xlf | 5 + src/fsharp/xlf/FSComp.txt.pt-BR.xlf | 5 + src/fsharp/xlf/FSComp.txt.ru.xlf | 5 + src/fsharp/xlf/FSComp.txt.tr.xlf | 5 + src/fsharp/xlf/FSComp.txt.zh-Hans.xlf | 5 + src/fsharp/xlf/FSComp.txt.zh-Hant.xlf | 5 + .../Language/OpenTypeDeclarationTests.fs | 493 +++++++++++++++++- 17 files changed, 632 insertions(+), 68 deletions(-) diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 4bdf3627857..f53eaf88cc6 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1482,6 +1482,7 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl 3247,couldNotLoadDependencyManagerExtension,"The dependency manager extension %s could not be loaded. Message: %s" 3250,expressionHasNoName,"Expression does not have a name." 3251,chkNoFirstClassNameOf,"Using the 'nameof' operator as a first-class function value is not permitted." +3252,tcIllegalByrefsInOpenTypeDeclaration,"Byref types are not allowed in an open type declaration." 3300,chkInvalidFunctionParameterType,"The parameter '%s' has an invalid type '%s'. This is not permitted by the rules of Common IL." 3301,chkInvalidFunctionReturnType,"The function or method has an invalid return type '%s'. This is not permitted by the rules of Common IL." 3302,packageManagementRequiresVFive,"The package management feature requires language version 5.0 use /langversion:preview" diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 98421be7a55..54218f823a9 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -774,60 +774,6 @@ let AddUnionCases2 bulkAddMode (eUnqualifiedItems: UnqualifiedItems) (ucrefs: Un let item = Item.UnionCase(GeneralizeUnionCaseRef ucref, false) acc.Add (ucref.CaseName, item)) -let GetStaticMethodItems infoReader nenv ad m ty = - let methGroups = - AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty - |> List.groupBy (fun m -> m.LogicalName) - - seq { - for (methName, methGroup) in methGroups do - let methGroup = - methGroup - |> List.filter (fun m -> - not (m.IsInstance || m.IsClassConstructor || m.IsConstructor) && typeEquiv infoReader.amap.g m.ApparentEnclosingType ty) - if not methGroup.IsEmpty then - yield KeyValuePair(methName, Item.MethodGroup(methName, methGroup, None)) - } - -let GetStaticPropertyItems infoReader nenv ad m ty = - let propInfos = - AllPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty - |> List.groupBy (fun m -> m.PropertyName) - - seq { - for (propName, propInfos) in propInfos do - let propInfos = - propInfos - |> List.filter (fun m -> - m.IsStatic && typeEquiv infoReader.amap.g m.ApparentEnclosingType ty) - for propInfo in propInfos do - yield KeyValuePair(propName , Item.Property(propName,[propInfo])) - } - -let GetStaticILFieldItems (infoReader: InfoReader) ad m ty = - let fields = - infoReader.GetILFieldInfosOfType(None, ad, m, ty) - |> List.groupBy (fun f -> f.FieldName) - - seq { - for (fieldName, fieldInfos) in fields do - let fieldInfos = fieldInfos |> List.filter (fun fi -> fi.IsStatic) - for fieldInfo in fieldInfos do - yield KeyValuePair(fieldName, Item.ILField(fieldInfo)) - } - -let GetStaticEventItems (infoReader: InfoReader) ad m ty = - let events = - infoReader.GetEventInfosOfType(None, ad, m, ty) - |> List.groupBy (fun e -> e.EventName) - - seq { - for (eventName, eventInfos) in events do - let eventInfos = eventInfos |> List.filter (fun e -> e.IsStatic) - for eventInfo in eventInfos do - yield KeyValuePair(eventName, Item.Event(eventInfo)) - } - //------------------------------------------------------------------------- // TypeNameResolutionInfo //------------------------------------------------------------------------- @@ -1058,28 +1004,90 @@ let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, che GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty |> List.map (fun (tcref, tinst) -> MakeNestedType ncenv tinst m tcref) +let ChooseMethInfosForNameEnv g ty (minfos: MethInfo list) = + let methGroups = + minfos + |> List.filter (fun minfo -> + not (minfo.IsInstance || minfo.IsClassConstructor || minfo.IsConstructor) && typeEquiv g minfo.ApparentEnclosingType ty) + |> List.groupBy (fun minfo -> minfo.LogicalName) + + seq { + for (methName, methGroup) in methGroups do + if not methGroup.IsEmpty then + KeyValuePair(methName, Item.MethodGroup(methName, methGroup, None)) + } + +let ChoosePropInfosForNameEnv g ty (pinfos: PropInfo list) = + let propGroups = + pinfos + |> List.filter (fun pinfo -> + pinfo.IsStatic && typeEquiv g pinfo.ApparentEnclosingType ty) + |> List.groupBy (fun pinfo -> pinfo.PropertyName) + + seq { + for (propName, propGroup) in propGroups do + if not propGroup.IsEmpty then + KeyValuePair(propName, Item.Property(propName, propGroup)) + } + +let ChooseILFieldInfosForNameEnv g ty (finfos: ILFieldInfo list) = + seq { + for finfo in finfos do + if finfo.IsStatic && typeEquiv g finfo.ApparentEnclosingType ty then + KeyValuePair(finfo.FieldName, Item.ILField finfo) + } + +let ChooseEventInfosForNameEnv g ty (einfos: EventInfo list) = + seq { + for einfo in einfos do + if einfo.IsStatic && typeEquiv g einfo.ApparentEnclosingType ty then + KeyValuePair(einfo.EventName, Item.Event einfo) + } + let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) + // The order of items matter such as intrinsic members will always be favored over extension members of the same name. + // Extension property members will always be favored over extenion methods of the same name. let items = [| - yield! GetStaticMethodItems infoReader nenv ad m ty - yield! GetStaticPropertyItems infoReader nenv ad m ty - yield! GetStaticILFieldItems infoReader ad m ty - yield! GetStaticEventItems infoReader ad m ty - |] + // Extension methods + yield! + ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None m ty + |> ChooseMethInfosForNameEnv g ty + // Extension properties + yield! + ExtensionPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad m ty + |> ChoosePropInfosForNameEnv g ty + + // Methods + yield! + IntrinsicMethInfosOfType infoReader None ad AllowMultiIntfInstantiations.Yes PreferOverrides m ty + |> ChooseMethInfosForNameEnv g ty + + // Properties + yield! + IntrinsicPropInfosOfTypeInScope infoReader None ad PreferOverrides m ty + |> ChoosePropInfosForNameEnv g ty + + // Events + yield! + infoReader.GetEventInfosOfType(None, ad, m, ty) + |> ChooseEventInfosForNameEnv g ty + + // Fields + yield! + infoReader.GetILFieldInfosOfType(None, ad, m, ty) + |> ChooseILFieldInfosForNameEnv g ty + |] let nenv = { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad m nenv ty = - let nestedTcrefGroups = - GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty - |> List.groupBy (fun (tcref, _) -> DemangleGenericTypeName tcref.LogicalName) - - (nenv, nestedTcrefGroups) - ||> List.fold (fun nenv (_, nestedTypes) -> AddTyconRefsWithTypeArgsToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv nestedTypes) + GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty + |> AddTyconRefsWithTypeArgsToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv and private AddTyconRefsWithTypeArgsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tcrefsWithArgs: (TyconRef * TTypes) list) = let tcrefs = tcrefsWithArgs |> List.map (fun (tcref, _) -> tcref) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index b4fde84190b..85f8ec893cf 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -13022,8 +13022,7 @@ let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) = error(Error(FSComp.SR.tcNamedTypeRequired("open type"), m)) if isByrefTy g typ then - // TODO: Better error. - error(Error(FSComp.SR.tcByrefsMayNotHaveTypeExtensions(), m)) + error(Error(FSComp.SR.tcIllegalByrefsInOpenTypeDeclaration(), m)) let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type (synType, m), [], [typ], scopem, false) let env = OpenTypeContent cenv.tcSink g cenv.amap scopem env typ openDecl diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index a850949dd62..dba176f32c0 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -222,6 +222,11 @@ Atributy nejde použít pro rozšíření typů. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use! se nedá kombinovat s and!. diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index 88976031efd..c1346d1ff8d 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -222,6 +222,11 @@ Attribute können nicht auf Typerweiterungen angewendet werden. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! "use!" darf nicht mit "and!" kombiniert werden. diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 0bd2bfbd7ed..b9fe8a8fcd6 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -222,6 +222,11 @@ Los atributos no se pueden aplicar a las extensiones de tipo. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! No se puede combinar use! con and! diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 06551c90dfe..8b00c8789a2 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -222,6 +222,11 @@ Impossible d'appliquer des attributs aux extensions de type. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use! ne peut pas être combiné avec and! diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 3e6a6f7353c..42ef3b6ffef 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -222,6 +222,11 @@ Gli attributi non possono essere applicati a estensioni di tipo. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! Non è possibile combinare use! con and! diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 02677df0184..6ca036441ca 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -222,6 +222,11 @@ 属性を型拡張に適用することはできません。 + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use! を and! と組み合わせて使用することはできません diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index 14348499d13..4c684a519ee 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -222,6 +222,11 @@ 형식 확장에 특성을 적용할 수 없습니다. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use!는 and!와 함께 사용할 수 없습니다. diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index d616391bdb9..19b57df0b5c 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -222,6 +222,11 @@ Atrybutów nie można stosować do rozszerzeń typu. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! Elementu use! nie można łączyć z elementem and! diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index 10fe50f23f4..dc928504ab3 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -222,6 +222,11 @@ Os atributos não podem ser aplicados às extensões de tipo. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use! não pode ser combinado com and! diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index 7c8d7540d02..2994b2d74b2 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -222,6 +222,11 @@ Атрибуты не могут быть применены к расширениям типа. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use! запрещено сочетать с and! diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index 7544aa4894d..d7f1f72a928 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -222,6 +222,11 @@ Öznitelikler tür uzantılarına uygulanamaz. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use!, and! ile birleştirilemez diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index f08688ee66f..5ccc1581472 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -222,6 +222,11 @@ 属性不可应用于类型扩展。 + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use! 不得与 and! 结合使用 diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index 5e61947b55c..a51af384b6b 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -222,6 +222,11 @@ 屬性無法套用到類型延伸模組。 + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + use! may not be combined with and! use! 不可與 and! 合併 diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index ee28e55fb44..2d46499f34d 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -7,7 +7,6 @@ open NUnit.Framework open FSharp.Test.Utilities open FSharp.Test.Utilities.Utilities - (* Tests in this file evaluate whether the language supports accessing functions on static classes using open The feature was added in preview, the test cases ensure that the original errors are reproduced when the langversion:4.6 is specified @@ -476,6 +475,498 @@ open type System (FSharpErrorSeverity.Error, 39, (4, 11, 4, 17), "The type 'System' is not defined.") |]) + [] + let ``Open type declaration on a module - Error`` () = + let fsharpSource = + """ +namespace FSharpTest + +open type FSharp.Core.Option + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|]) + + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 33, (4, 11, 4, 29), "The type 'Microsoft.FSharp.Core.Option<_>' expects 1 type argument(s) but is given 0") + |]) + + [] + let ``Open type declaration on a byref - Error`` () = + let fsharpSource = + """ +namespace FSharpTest + +open type byref +open type inref +open type outref + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|]) + + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 3252, (4, 11, 4, 21), "Byref types are not allowed in an open type declaration.") + (FSharpErrorSeverity.Error, 3252, (5, 11, 5, 21), "Byref types are not allowed in an open type declaration.") + (FSharpErrorSeverity.Error, 3252, (6, 11, 6, 22), "Byref types are not allowed in an open type declaration.") + |]) + + [] + let ``Type extensions with static members are able to be accessed in an unqualified manner`` () = + let fsharpSource = + """ +open System + +type A () = + + static member M() = Console.Write "M" + + static member P = Console.Write "P" + +[] +module AExtensions = + + type A with + + static member M2() = Console.Write "M2Ext" + + static member P2 = Console.Write "P2Ext" + +open type A + +[] +let main _ = + M() + P + M2() + P2 + 0 + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.ExecutionHasOutput(fsCmpl, "MPM2ExtP2Ext") + + [] + let ``Type extensions with static members are able to be accessed in an unqualified manner with no shadowing on identical names`` () = + let fsharpSource = + """ +open System + +type A () = + + static member M() = Console.Write "M" + + static member P = Console.Write "P" + +[] +module AExtensions = + + type A with + + static member M() = Console.Write "MExt" + + static member P = Console.Write "PExt" + +open type A + +[] +let main _ = + M() + P + 0 + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.ExecutionHasOutput(fsCmpl, "MP") + + [] + let ``Type extensions with static members are able to be accessed in an unqualified manner with the nuance of favoring extension properties over extension methods of identical names`` () = + let fsharpSource = + """ +open System + +type A () = + + static member P = Console.Write "P" + +[] +module AExtensions = + + type A with + + static member M = Console.Write "MExt" + +[] +module AExtensions2 = + + type A with + + static member M() = Console.Write "M" + +open type A + +[] +let main _ = + M + P + 0 + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.ExecutionHasOutput(fsCmpl, "MExtP") + + [] + let ``Type extensions with static members are able to be accessed in an unqualified manner with no shadowing on identical method/property names`` () = + let fsharpSource = + """ +open System + +type A () = + + static member M() = Console.Write "M" + +[] +module AExtensions = + + type A with + + static member M = Console.Write "MExt" + +open type A + +[] +let main _ = + M() + 0 + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.ExecutionHasOutput(fsCmpl, "M") + + [] + let ``An assembly with an event and field with the same name, favor the field`` () = + let ilSource = + """ +.assembly il.dll +{ +} +.class public auto ansi abstract sealed beforefieldinit ILTest.C + extends [netstandard]System.Object +{ + .field public static class [netstandard]System.EventHandler E + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .method public hidebysig specialname static + void add_E ( + class [netstandard]System.EventHandler 'value' + ) cil managed + { + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 3 + .locals init ( + [0] class [netstandard]System.EventHandler, + [1] class [netstandard]System.EventHandler, + [2] class [netstandard]System.EventHandler + ) + + IL_0000: ldsfld class [netstandard]System.EventHandler ILTest.C::E + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: stloc.1 + IL_0008: ldloc.1 + IL_0009: ldarg.0 + IL_000a: call class [netstandard]System.Delegate [netstandard]System.Delegate::Combine(class [netstandard]System.Delegate, class [netstandard]System.Delegate) + IL_000f: castclass [netstandard]System.EventHandler + IL_0014: stloc.2 + IL_0015: ldsflda class [netstandard]System.EventHandler ILTest.C::E + IL_001a: ldloc.2 + IL_001b: ldloc.1 + IL_001c: call !!0 [netstandard]System.Threading.Interlocked::CompareExchange(!!0&, !!0, !!0) + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldloc.1 + IL_0024: bne.un.s IL_0006 + IL_0026: ret + } + + .method public hidebysig specialname static + void remove_E ( + class [netstandard]System.EventHandler 'value' + ) cil managed + { + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 3 + .locals init ( + [0] class [netstandard]System.EventHandler, + [1] class [netstandard]System.EventHandler, + [2] class [netstandard]System.EventHandler + ) + + IL_0000: ldsfld class [netstandard]System.EventHandler ILTest.C::E + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: stloc.1 + IL_0008: ldloc.1 + IL_0009: ldarg.0 + IL_000a: call class [netstandard]System.Delegate [netstandard]System.Delegate::Remove(class [netstandard]System.Delegate, class [netstandard]System.Delegate) + IL_000f: castclass [netstandard]System.EventHandler + IL_0014: stloc.2 + IL_0015: ldsflda class [netstandard]System.EventHandler ILTest.C::E + IL_001a: ldloc.2 + IL_001b: ldloc.1 + IL_001c: call !!0 [netstandard]System.Threading.Interlocked::CompareExchange(!!0&, !!0, !!0) + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldloc.1 + IL_0024: bne.un.s IL_0006 + IL_0026: ret + } + + .event [netstandard]System.EventHandler X + { + .addon void ILTest.C::add_E(class [netstandard]System.EventHandler) + .removeon void ILTest.C::remove_E(class [netstandard]System.EventHandler) + } + + .field public static int32 X +} + """ + + let fsharpSource = + """ +module FSharpTest + +open ILTest + +let x1: int = C.X + +open type C + +let x2: int = X + """ + + let ilCmpl = + CompilationUtil.CreateILCompilation ilSource + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [ilCmpl]) + + CompilerAssert.Compile(fsCmpl) + + [] + let ``An assembly with an event and field with the same name, favor the field - reversed`` () = + let ilSource = + """ +.assembly il.dll +{ +} +.class public auto ansi abstract sealed beforefieldinit ILTest.C + extends [netstandard]System.Object +{ + .field public static int32 X + .field public static class [netstandard]System.EventHandler E + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .method public hidebysig specialname static + void add_E ( + class [netstandard]System.EventHandler 'value' + ) cil managed + { + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 3 + .locals init ( + [0] class [netstandard]System.EventHandler, + [1] class [netstandard]System.EventHandler, + [2] class [netstandard]System.EventHandler + ) + + IL_0000: ldsfld class [netstandard]System.EventHandler ILTest.C::E + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: stloc.1 + IL_0008: ldloc.1 + IL_0009: ldarg.0 + IL_000a: call class [netstandard]System.Delegate [netstandard]System.Delegate::Combine(class [netstandard]System.Delegate, class [netstandard]System.Delegate) + IL_000f: castclass [netstandard]System.EventHandler + IL_0014: stloc.2 + IL_0015: ldsflda class [netstandard]System.EventHandler ILTest.C::E + IL_001a: ldloc.2 + IL_001b: ldloc.1 + IL_001c: call !!0 [netstandard]System.Threading.Interlocked::CompareExchange(!!0&, !!0, !!0) + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldloc.1 + IL_0024: bne.un.s IL_0006 + IL_0026: ret + } + + .method public hidebysig specialname static + void remove_E ( + class [netstandard]System.EventHandler 'value' + ) cil managed + { + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 3 + .locals init ( + [0] class [netstandard]System.EventHandler, + [1] class [netstandard]System.EventHandler, + [2] class [netstandard]System.EventHandler + ) + + IL_0000: ldsfld class [netstandard]System.EventHandler ILTest.C::E + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: stloc.1 + IL_0008: ldloc.1 + IL_0009: ldarg.0 + IL_000a: call class [netstandard]System.Delegate [netstandard]System.Delegate::Remove(class [netstandard]System.Delegate, class [netstandard]System.Delegate) + IL_000f: castclass [netstandard]System.EventHandler + IL_0014: stloc.2 + IL_0015: ldsflda class [netstandard]System.EventHandler ILTest.C::E + IL_001a: ldloc.2 + IL_001b: ldloc.1 + IL_001c: call !!0 [netstandard]System.Threading.Interlocked::CompareExchange(!!0&, !!0, !!0) + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldloc.1 + IL_0024: bne.un.s IL_0006 + IL_0026: ret + } + + .event [netstandard]System.EventHandler X + { + .addon void ILTest.C::add_E(class [netstandard]System.EventHandler) + .removeon void ILTest.C::remove_E(class [netstandard]System.EventHandler) + } +} + """ + + let fsharpSource = + """ +module FSharpTest + +open ILTest + +let x1: int = C.X + +open type C + +let x2: int = X + """ + + let ilCmpl = + CompilationUtil.CreateILCompilation ilSource + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [ilCmpl]) + + CompilerAssert.Compile(fsCmpl) + + [] + let ``C# with explicit implementation - Runs`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public interface ITest1 + { + void Method1() + { + Console.Write("ITest1." + nameof(Method1)); + } + + void Method2(); + } + + public interface ITest2 : ITest1 + { + void ITest1.Method2() + { + Console.Write("ITest2" + nameof(Method2)); + } + + void Method3(); + } + + public interface ITest3 : ITest2 + { + void ITest2.Method3() + { + Console.Write("ITest3" + nameof(Method3)); + } + + void Method4(); + } +} + """ + + let fsharpSource = + """ +open System +open CSharpTest + +type Test () = + + interface ITest3 with + + member __.Method1 () = Console.Write("FSharp-Method1") + + member __.Method2 () = Console.Write("FSharp-Method2") + + member __.Method3 () = Console.Write("FSharp-Method3") + + member __.Method4 () = Console.Write("FSharp-Method4") + +[] +let main _ = + let test = Test () :> ITest3 + test.Method1 () + Console.Write("-") + test.Method2 () + Console.Write("-") + test.Method3 () + Console.Write("-") + test.Method4 () + 0 + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:4.6"|], cmplRefs = [csCmpl]) + + CompilerAssert.ExecutionHasOutput(fsCmpl, "FSharp-Method1-FSharp-Method2-FSharp-Method3-FSharp-Method4") + // TODO - wait for Will's integration of testing changes that makes this easlier // [] // let ``OpenStaticClassesTests - InternalsVisibleWhenHavingAnIVT - langversion:preview``() = ... From 270313d59c1c0751088ef404bac0c09eea3fc82c Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 8 Jul 2020 17:20:40 -0700 Subject: [PATCH 39/89] More tests --- src/fsharp/NameResolution.fs | 20 +- .../Language/OpenTypeDeclarationTests.fs | 369 +++++++++++++++--- 2 files changed, 335 insertions(+), 54 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 54218f823a9..f840e0971ca 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1061,16 +1061,6 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n ExtensionPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad m ty |> ChoosePropInfosForNameEnv g ty - // Methods - yield! - IntrinsicMethInfosOfType infoReader None ad AllowMultiIntfInstantiations.Yes PreferOverrides m ty - |> ChooseMethInfosForNameEnv g ty - - // Properties - yield! - IntrinsicPropInfosOfTypeInScope infoReader None ad PreferOverrides m ty - |> ChoosePropInfosForNameEnv g ty - // Events yield! infoReader.GetEventInfosOfType(None, ad, m, ty) @@ -1080,6 +1070,16 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n yield! infoReader.GetILFieldInfosOfType(None, ad, m, ty) |> ChooseILFieldInfosForNameEnv g ty + + // Properties + yield! + IntrinsicPropInfosOfTypeInScope infoReader None ad PreferOverrides m ty + |> ChoosePropInfosForNameEnv g ty + + // Methods + yield! + IntrinsicMethInfosOfType infoReader None ad AllowMultiIntfInstantiations.Yes PreferOverrides m ty + |> ChooseMethInfosForNameEnv g ty |] let nenv = { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 2d46499f34d..2edbe52a30b 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -754,6 +754,14 @@ module FSharpTest open ILTest +type C with + + member _.X = obj () + +type C with + + member _.X() = obj () + let x1: int = C.X open type C @@ -872,6 +880,14 @@ module FSharpTest open ILTest +type C with + + member _.X = obj () + +type C with + + member _.X() = obj () + let x1: int = C.X open type C @@ -889,72 +905,341 @@ let x2: int = X CompilerAssert.Compile(fsCmpl) [] - let ``C# with explicit implementation - Runs`` () = - let csharpSource = + let ``An assembly with a property, event, and field with the same name`` () = + let ilSource = """ -using System; +.assembly il.dll +{ +} +.class public auto ansi abstract sealed beforefieldinit ILTest.C + extends [netstandard]System.Object +{ + .field public static class [netstandard]System.EventHandler E + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) -namespace CSharpTest + .method public hidebysig specialname static + void add_E ( + class [netstandard]System.EventHandler 'value' + ) cil managed + { + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 3 + .locals init ( + [0] class [netstandard]System.EventHandler, + [1] class [netstandard]System.EventHandler, + [2] class [netstandard]System.EventHandler + ) + + IL_0000: ldsfld class [netstandard]System.EventHandler ILTest.C::E + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: stloc.1 + IL_0008: ldloc.1 + IL_0009: ldarg.0 + IL_000a: call class [netstandard]System.Delegate [netstandard]System.Delegate::Combine(class [netstandard]System.Delegate, class [netstandard]System.Delegate) + IL_000f: castclass [netstandard]System.EventHandler + IL_0014: stloc.2 + IL_0015: ldsflda class [netstandard]System.EventHandler ILTest.C::E + IL_001a: ldloc.2 + IL_001b: ldloc.1 + IL_001c: call !!0 [netstandard]System.Threading.Interlocked::CompareExchange(!!0&, !!0, !!0) + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldloc.1 + IL_0024: bne.un.s IL_0006 + IL_0026: ret + } + + .method public hidebysig specialname static + void remove_E ( + class [netstandard]System.EventHandler 'value' + ) cil managed + { + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 3 + .locals init ( + [0] class [netstandard]System.EventHandler, + [1] class [netstandard]System.EventHandler, + [2] class [netstandard]System.EventHandler + ) + + IL_0000: ldsfld class [netstandard]System.EventHandler ILTest.C::E + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: stloc.1 + IL_0008: ldloc.1 + IL_0009: ldarg.0 + IL_000a: call class [netstandard]System.Delegate [netstandard]System.Delegate::Remove(class [netstandard]System.Delegate, class [netstandard]System.Delegate) + IL_000f: castclass [netstandard]System.EventHandler + IL_0014: stloc.2 + IL_0015: ldsflda class [netstandard]System.EventHandler ILTest.C::E + IL_001a: ldloc.2 + IL_001b: ldloc.1 + IL_001c: call !!0 [netstandard]System.Threading.Interlocked::CompareExchange(!!0&, !!0, !!0) + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldloc.1 + IL_0024: bne.un.s IL_0006 + IL_0026: ret + } + + .event [netstandard]System.EventHandler X + { + .addon void ILTest.C::add_E(class [netstandard]System.EventHandler) + .removeon void ILTest.C::remove_E(class [netstandard]System.EventHandler) + } + + .field public static int32 X + + .field private static initonly string 'k__BackingField' + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .method public hidebysig specialname static + string get_Y () cil managed + { + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 8 + + IL_0000: ldsfld string ILTest.C::'k__BackingField' + IL_0005: ret + } + + .property string X() + { + .get string ILTest.C::get_Y() + } +} + """ + + let fsharpSource = + """ +module FSharpTest + +open ILTest + +type C with + + member _.X = obj () + +type C with + + member _.X() = obj () + +let x1: string = C.X + +open type C + +let x2: string = X + """ + + let ilCmpl = + CompilationUtil.CreateILCompilation ilSource + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [ilCmpl]) + + CompilerAssert.Compile(fsCmpl) + + [] + let ``An assembly with a method, property, event, and field with the same name`` () = + let ilSource = + """ +.assembly il.dll +{ +} +.class public auto ansi abstract sealed beforefieldinit ILTest.C + extends [netstandard]System.Object { - public interface ITest1 + .field public static class [netstandard]System.EventHandler E + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .method public hidebysig specialname static + void add_E ( + class [netstandard]System.EventHandler 'value' + ) cil managed { - void Method1() - { - Console.Write("ITest1." + nameof(Method1)); - } + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) - void Method2(); + .maxstack 3 + .locals init ( + [0] class [netstandard]System.EventHandler, + [1] class [netstandard]System.EventHandler, + [2] class [netstandard]System.EventHandler + ) + + IL_0000: ldsfld class [netstandard]System.EventHandler ILTest.C::E + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: stloc.1 + IL_0008: ldloc.1 + IL_0009: ldarg.0 + IL_000a: call class [netstandard]System.Delegate [netstandard]System.Delegate::Combine(class [netstandard]System.Delegate, class [netstandard]System.Delegate) + IL_000f: castclass [netstandard]System.EventHandler + IL_0014: stloc.2 + IL_0015: ldsflda class [netstandard]System.EventHandler ILTest.C::E + IL_001a: ldloc.2 + IL_001b: ldloc.1 + IL_001c: call !!0 [netstandard]System.Threading.Interlocked::CompareExchange(!!0&, !!0, !!0) + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldloc.1 + IL_0024: bne.un.s IL_0006 + IL_0026: ret } - public interface ITest2 : ITest1 + .method public hidebysig specialname static + void remove_E ( + class [netstandard]System.EventHandler 'value' + ) cil managed { - void ITest1.Method2() - { - Console.Write("ITest2" + nameof(Method2)); - } + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 3 + .locals init ( + [0] class [netstandard]System.EventHandler, + [1] class [netstandard]System.EventHandler, + [2] class [netstandard]System.EventHandler + ) - void Method3(); + IL_0000: ldsfld class [netstandard]System.EventHandler ILTest.C::E + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: stloc.1 + IL_0008: ldloc.1 + IL_0009: ldarg.0 + IL_000a: call class [netstandard]System.Delegate [netstandard]System.Delegate::Remove(class [netstandard]System.Delegate, class [netstandard]System.Delegate) + IL_000f: castclass [netstandard]System.EventHandler + IL_0014: stloc.2 + IL_0015: ldsflda class [netstandard]System.EventHandler ILTest.C::E + IL_001a: ldloc.2 + IL_001b: ldloc.1 + IL_001c: call !!0 [netstandard]System.Threading.Interlocked::CompareExchange(!!0&, !!0, !!0) + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldloc.1 + IL_0024: bne.un.s IL_0006 + IL_0026: ret } - public interface ITest3 : ITest2 + .event [netstandard]System.EventHandler X { - void ITest2.Method3() - { - Console.Write("ITest3" + nameof(Method3)); - } + .addon void ILTest.C::add_E(class [netstandard]System.EventHandler) + .removeon void ILTest.C::remove_E(class [netstandard]System.EventHandler) + } + + .field public static int32 X + + .field private static initonly string 'k__BackingField' + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) - void Method4(); + .method public hidebysig specialname static + string get_Y () cil managed + { + .custom instance void [netstandard]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( + 01 00 00 00 + ) + + .maxstack 8 + + IL_0000: ldsfld string ILTest.C::'k__BackingField' + IL_0005: ret + } + + .property string X() + { + .get string ILTest.C::get_Y() + } + + .method public hidebysig static + float32 X () cil managed + { + .maxstack 8 + + IL_0000: ldc.r4 0.0 + IL_0005: ret } } """ let fsharpSource = """ -open System -open CSharpTest +module FSharpTest + +open ILTest + +type C with + + member _.X = obj () + +type C with + + member _.X() = obj () + +let x1: float32 = C.X() + +open type C + +let x2: float32 = X() + """ -type Test () = + let ilCmpl = + CompilationUtil.CreateILCompilation ilSource + |> CompilationReference.Create - interface ITest3 with + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [ilCmpl]) + + CompilerAssert.Compile(fsCmpl) - member __.Method1 () = Console.Write("FSharp-Method1") + [] + let ``Opening an interface with a static method`` () = + let csharpSource = + """ +using System; - member __.Method2 () = Console.Write("FSharp-Method2") +namespace CSharpTest +{ + public interface ITest + { + public static void M() + { + } + } +} + """ - member __.Method3 () = Console.Write("FSharp-Method3") + let fsharpSource = + """ +open System +open CSharpTest - member __.Method4 () = Console.Write("FSharp-Method4") +open type ITest [] let main _ = - let test = Test () :> ITest3 - test.Method1 () - Console.Write("-") - test.Method2 () - Console.Write("-") - test.Method3 () - Console.Write("-") - test.Method4 () + M() 0 """ @@ -963,10 +1248,6 @@ let main _ = |> CompilationReference.Create let fsCmpl = - Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:4.6"|], cmplRefs = [csCmpl]) + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - CompilerAssert.ExecutionHasOutput(fsCmpl, "FSharp-Method1-FSharp-Method2-FSharp-Method3-FSharp-Method4") - - // TODO - wait for Will's integration of testing changes that makes this easlier - // [] - // let ``OpenStaticClassesTests - InternalsVisibleWhenHavingAnIVT - langversion:preview``() = ... + CompilerAssert.Compile(fsCmpl) From 45a5d109f810ed16c726bd6247c1dba48be7899e Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 8 Jul 2020 17:38:25 -0700 Subject: [PATCH 40/89] More tests --- .../Language/OpenTypeDeclarationTests.fs | 83 +++++++++++++++++++ 1 file changed, 83 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 2edbe52a30b..e9871706b4e 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -1251,3 +1251,86 @@ let main _ = Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) CompilerAssert.Compile(fsCmpl) + + [] + let ``Opening an interface with an internal static method`` () = + let csharpSource = + """ +using System; +using System.Runtime.CompilerServices; + +[assembly:InternalsVisibleTo("Test")] + +namespace CSharpTest +{ + public interface ITest + { + internal static void M() + { + } + } +} + """ + + let fsharpSource = + """ +open System +open CSharpTest + +open type ITest + +[] +let main _ = + M() + 0 + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|], cmplRefs = [csCmpl], name = "Test") + + CompilerAssert.Compile(fsCmpl) + + [] + let ``Opening an interface with an internal static method - Error`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public interface ITest + { + internal static void M() + { + } + } +} + """ + + let fsharpSource = + """ +open System +open CSharpTest + +open type ITest + +[] +let main _ = + M() + 0 + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) + + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 39, (9, 5, 9, 6), "The value or constructor 'M' is not defined.") + |]) From e8c75aaf149a45f8903535abf95504670e82fa44 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 8 Jul 2020 17:41:10 -0700 Subject: [PATCH 41/89] Update tests --- tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index e9871706b4e..c6f5ee67703 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -1213,6 +1213,8 @@ let x2: float32 = X() CompilerAssert.Compile(fsCmpl) +#if NETCOREAPP + [] let ``Opening an interface with a static method`` () = let csharpSource = @@ -1334,3 +1336,5 @@ let main _ = CompilerAssert.CompileWithErrors(fsCmpl, [| (FSharpErrorSeverity.Error, 39, (9, 5, 9, 6), "The value or constructor 'M' is not defined.") |]) + +#endif From e9fc47a71e176076651e539a94db12fa29065768 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 8 Jul 2020 17:55:31 -0700 Subject: [PATCH 42/89] Rename --- src/fsharp/NameResolution.fs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index f840e0971ca..48b716f9040 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1343,15 +1343,15 @@ let AddDeclaredTyparsToNameEnv check nenv typars = //------------------------------------------------------------------------- /// Convert a reference to a named type into a type that includes -/// a fresh set of inference type variables for the type parameters of the union type. +/// a fresh set of inference type variables for the type parameters. let FreshenTycon (ncenv: NameResolver) m (tcref: TyconRef) = let tinst = ncenv.InstantiationGenerator m (tcref.Typars m) let improvedTy = ncenv.g.decompileType tcref tinst improvedTy -/// Convert a reference to a named nested type into a type that includes -/// a fresh set of inference type variables for the type parameters and the given type arguments. -let FreshenNestedTycon (ncenv: NameResolver) m (tcrefNested: TyconRef) (tinstDeclaring: TypeInst) = +/// Convert a reference to a named type into a type that includes +/// a set of declaring type variables and a fresh set of inference type variables for the type parameters. +let FreshenTyconWithDeclaringTypeArgs (ncenv: NameResolver) m (tcrefNested: TyconRef) (tinstDeclaring: TypeInst) = let tps = ncenv.InstantiationGenerator m (tcrefNested.Typars m) let tinstNested = List.skip tinstDeclaring.Length tps let improvedTy = ncenv.g.decompileType tcrefNested (tinstDeclaring @ tinstNested) @@ -2622,7 +2622,7 @@ let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameR | None -> (resInfo, FreshenTycon ncenv m tcref) | Some tinst -> - (resInfo, FreshenNestedTycon ncenv m tcref tinst)) + (resInfo, FreshenTyconWithDeclaringTypeArgs ncenv m tcref tinst)) tys |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) @@ -2634,7 +2634,7 @@ let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameR | None -> (resInfo, FreshenTycon ncenv m tcref) | Some tinst -> - (resInfo, FreshenNestedTycon ncenv m tcref tinst)) + (resInfo, FreshenTyconWithDeclaringTypeArgs ncenv m tcref tinst)) success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty]), []))) /// Resolve F# "A.B.C" syntax in expressions From eeaa6c7c8c74d3a6b5e2b832b7bc06b9ae88d566 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 9 Jul 2020 12:27:11 -0700 Subject: [PATCH 43/89] Better names --- src/fsharp/NameResolution.fs | 44 +++++++++++++++++------------------ src/fsharp/NameResolution.fsi | 2 +- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 48b716f9040..83103e70949 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -334,8 +334,8 @@ type NameResolutionEnv = /// Values, functions, methods and other items available by unqualified name eUnqualifiedItems: UnqualifiedItems - /// Type arguments that are associated with an unqualified type item - eUnqualifiedTyconTypeArgs: TyconRefMap + /// Type instantiations that are associated with an unqualified type item + eUnqualifiedTyconDeclaringTypeInsts: TyconRefMap /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap @@ -395,7 +395,7 @@ type NameResolutionEnv = eFullyQualifiedModulesAndNamespaces = Map.empty eFieldLabels = Map.empty eUnqualifiedItems = LayeredMap.Empty - eUnqualifiedTyconTypeArgs = TyconRefMap.Empty + eUnqualifiedTyconDeclaringTypeInsts = TyconRefMap.Empty ePatItems = Map.empty eTyconsByAccessNames = LayeredMultiMap.Empty eTyconsByDemangledNameAndArity = LayeredMap.Empty @@ -1087,15 +1087,15 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad m nenv ty = GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty - |> AddTyconRefsWithTypeArgsToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv + |> AddTyconRefsWithTypeInstToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv -and private AddTyconRefsWithTypeArgsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tcrefsWithArgs: (TyconRef * TTypes) list) = +and private AddTyconRefsWithTypeInstToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tcrefsWithArgs: (TyconRef * TypeInst) list) = let tcrefs = tcrefsWithArgs |> List.map (fun (tcref, _) -> tcref) let nenv = AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs (nenv, tcrefsWithArgs) ||> List.fold (fun nenv (tcref, tinstDeclaring) -> if tinstDeclaring.IsEmpty then nenv - else { nenv with eUnqualifiedTyconTypeArgs = nenv.eUnqualifiedTyconTypeArgs.Add tcref tinstDeclaring }) + else { nenv with eUnqualifiedTyconDeclaringTypeInsts = nenv.eUnqualifiedTyconDeclaringTypeInsts.Add tcref tinstDeclaring }) /// Add any implied contents of a type definition to the environment. and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = @@ -1350,8 +1350,8 @@ let FreshenTycon (ncenv: NameResolver) m (tcref: TyconRef) = improvedTy /// Convert a reference to a named type into a type that includes -/// a set of declaring type variables and a fresh set of inference type variables for the type parameters. -let FreshenTyconWithDeclaringTypeArgs (ncenv: NameResolver) m (tcrefNested: TyconRef) (tinstDeclaring: TypeInst) = +/// a set of declaring type arguments and a fresh set of inference type variables for the type parameters. +let FreshenTyconWithDeclaringTypeInst (ncenv: NameResolver) m (tcrefNested: TyconRef) (tinstDeclaring: TypeInst) = let tps = ncenv.InstantiationGenerator m (tcrefNested.Typars m) let tinstNested = List.skip tinstDeclaring.Length tps let improvedTy = ncenv.g.decompileType tcrefNested (tinstDeclaring @ tinstNested) @@ -2610,7 +2610,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type /// An identifier has resolved to a type name in an expression (corresponding to one or more TyconRefs). /// Return either a set of constructors (later refined by overload resolution), or a set of TyconRefs. -let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, resInfo: ResolutionInfo, tcrefs) = +let ChooseUnqualifiedTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, resInfo: ResolutionInfo, tcrefs) = let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) match typeNameResInfo.ResolutionFlag with @@ -2618,24 +2618,24 @@ let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameR let tys = tcrefs |> List.map (fun (resInfo, tcref) -> - match nenv.eUnqualifiedTyconTypeArgs.TryFind tcref with + match nenv.eUnqualifiedTyconDeclaringTypeInsts.TryFind tcref with | None -> (resInfo, FreshenTycon ncenv m tcref) | Some tinst -> - (resInfo, FreshenTyconWithDeclaringTypeArgs ncenv m tcref tinst)) + (resInfo, FreshenTyconWithDeclaringTypeInst ncenv m tcref tinst)) tys |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) - |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) + |> MapResults (fun (resInfo, item) -> (resInfo, item)) | ResolveTypeNamesToTypeRefs -> let tys = tcrefs |> List.map (fun (resInfo, tcref) -> - match nenv.eUnqualifiedTyconTypeArgs.TryFind tcref with + match nenv.eUnqualifiedTyconDeclaringTypeInsts.TryFind tcref with | None -> (resInfo, FreshenTycon ncenv m tcref) | Some tinst -> - (resInfo, FreshenTyconWithDeclaringTypeArgs ncenv m tcref tinst)) - success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty]), []))) + (resInfo, FreshenTyconWithDeclaringTypeInst ncenv m tcref tinst)) + success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty])))) /// Resolve F# "A.B.C" syntax in expressions /// Not all of the sequence will necessarily be swallowed, i.e. we return some identifiers @@ -2676,10 +2676,10 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length) - let search = ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) + let search = ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) match AtMostOneResult m search with | Result _ as res -> - let resInfo, item, rest = ForceRaise res + let resInfo, item = ForceRaise res ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) Some(item, rest) | Exception e -> typeError <- Some e; None @@ -2693,8 +2693,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // Do not resolve `nameof` if the feature is unsupported, even if it is FSharp.Core None else - Some (fresh, []) - | _ -> Some (fresh, []) + Some (fresh, rest) + | _ -> Some (fresh, rest) | _ -> None @@ -2705,17 +2705,17 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // Check if it's a type name, e.g. a constructor call or a type instantiation let ctorSearch = let tcrefs = LookupTypeNameInEnvMaybeHaveArity fullyQualified id.idText typeNameResInfo nenv - ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) + ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) let implicitOpSearch() = if IsMangledOpName id.idText then - success [(resInfo, Item.ImplicitOp(id, ref None), [])] + success [(resInfo, Item.ImplicitOp(id, ref None))] else NoResultsOrUsefulErrors ctorSearch +++ implicitOpSearch - let resInfo, item, rest = + let resInfo, item = match AtMostOneResult m innerSearch with | Result _ as res -> ForceRaise res | _ -> diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index bb68b3bc8a9..d40819b5d76 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -161,7 +161,7 @@ type NameResolutionEnv = eUnqualifiedItems: LayeredMap /// Type arguments that are associated with an unqualified type item - eUnqualifiedTyconTypeArgs: TyconRefMap + eUnqualifiedTyconDeclaringTypeInsts: TyconRefMap /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap From 947e20309ae789a5fc1e37bda5a26f2f6dabe35c Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 14 Jul 2020 12:54:23 -0700 Subject: [PATCH 44/89] Added test case for inherited members --- .../Language/OpenTypeDeclarationTests.fs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index c6f5ee67703..fb2d3252d02 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -651,6 +651,22 @@ let main _ = CompilerAssert.ExecutionHasOutput(fsCmpl, "M") + [] + let ``Opened types do no allow unqualified access to their inherited type's members - Error`` () = + let fsharpSource = + """ +open type System.Math + +let x = Equals(2.0, 3.0) + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fsx, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 39, (4, 9, 4, 15), "The value or constructor 'Equals' is not defined.") + |]) + [] let ``An assembly with an event and field with the same name, favor the field`` () = let ilSource = From 1118595c7aac180c9cabdb0dc1c4ba4a763f57e3 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 14 Jul 2020 16:08:27 -0700 Subject: [PATCH 45/89] Added more tests with CSharp style extension members --- src/fsharp/NameResolution.fs | 74 ++++++++---- .../Language/OpenTypeDeclarationTests.fs | 108 ++++++++++++++++++ 2 files changed, 160 insertions(+), 22 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 83103e70949..f43c1589309 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -441,23 +441,37 @@ type ResultCollectionSettings = /// during type checking. let NextExtensionMethodPriority() = uint64 (newStamp()) +/// Checks if the type is used for C# style extension members. +let IsTyconRefUsedForCSharpStyleExtensionMembers g m (tcref: TyconRef) = + // Type must be non-generic and have 'Extension' attribute + isNil(tcref.Typars m) && TyconRefHasAttribute g m g.attrib_ExtensionAttribute tcref + +/// Checks if the type is used for C# style extension members. +let IsTypeUsedForCSharpStyleExtensionMembers g m ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> IsTyconRefUsedForCSharpStyleExtensionMembers g m tcref + | _ -> false + +/// A 'plain' method is an extension method not interpreted as an extension method. +let IsMethInfoPlainCSharpStyleExtensionMember g m isEnclosingExtTy (minfo: MethInfo) = + // Method must be static, have 'Extension' attribute, must not be curried, must have at least one argument + isEnclosingExtTy && + not minfo.IsInstance && + not minfo.IsExtensionMember && + (match minfo.NumArgs with [x] when x >= 1 -> true | _ -> false) && + MethInfoHasAttribute g m g.attrib_ExtensionAttribute minfo + /// Get the info for all the .NET-style extension members listed as static members in the type. let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap: Import.ImportMap) m (tcrefOfStaticClass: TyconRef) = let g = amap.g - // Type must be non-generic and have 'Extension' attribute - if isNil(tcrefOfStaticClass.Typars m) && TyconRefHasAttribute g m g.attrib_ExtensionAttribute tcrefOfStaticClass then + + if IsTyconRefUsedForCSharpStyleExtensionMembers g m tcrefOfStaticClass then let pri = NextExtensionMethodPriority() let ty = generalizedTyconRef tcrefOfStaticClass - // Get the 'plain' methods, not interpreted as extension methods let minfos = GetImmediateIntrinsicMethInfosOfType (None, AccessorDomain.AccessibleFromSomeFSharpCode) g amap m ty [ for minfo in minfos do - // Method must be static, have 'Extension' attribute, must not be curried, must have at least one argument - if not minfo.IsInstance && - not minfo.IsExtensionMember && - (match minfo.NumArgs with [x] when x >= 1 -> true | _ -> false) && - MethInfoHasAttribute g m g.attrib_ExtensionAttribute minfo - then + if IsMethInfoPlainCSharpStyleExtensionMember g m true minfo then let ilExtMem = ILExtMem (tcrefOfStaticClass, minfo, pri) // The results are indexed by the TyconRef of the first 'this' argument, if any. @@ -1004,11 +1018,14 @@ let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, che GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty |> List.map (fun (tcref, tinst) -> MakeNestedType ncenv tinst m tcref) -let ChooseMethInfosForNameEnv g ty (minfos: MethInfo list) = +let ChooseMethInfosForNameEnv g m ty (minfos: MethInfo list) = + let isExtTy = IsTypeUsedForCSharpStyleExtensionMembers g m ty + let methGroups = minfos |> List.filter (fun minfo -> - not (minfo.IsInstance || minfo.IsClassConstructor || minfo.IsConstructor) && typeEquiv g minfo.ApparentEnclosingType ty) + not (minfo.IsInstance || minfo.IsClassConstructor || minfo.IsConstructor) && typeEquiv g minfo.ApparentEnclosingType ty && + not (IsMethInfoPlainCSharpStyleExtensionMember g m isExtTy minfo)) |> List.groupBy (fun minfo -> minfo.LogicalName) seq { @@ -1047,6 +1064,8 @@ let ChooseEventInfosForNameEnv g ty (einfos: EventInfo list) = let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) + let nenv = AddCSharpStyleExtensionMembersOfTypeToNameEnv amap m nenv ty + // The order of items matter such as intrinsic members will always be favored over extension members of the same name. // Extension property members will always be favored over extenion methods of the same name. let items = @@ -1054,7 +1073,7 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n // Extension methods yield! ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None m ty - |> ChooseMethInfosForNameEnv g ty + |> ChooseMethInfosForNameEnv g m ty // Extension properties yield! @@ -1079,7 +1098,7 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n // Methods yield! IntrinsicMethInfosOfType infoReader None ad AllowMultiIntfInstantiations.Yes PreferOverrides m ty - |> ChooseMethInfosForNameEnv g ty + |> ChooseMethInfosForNameEnv g m ty |] let nenv = { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } @@ -1097,6 +1116,24 @@ and private AddTyconRefsWithTypeInstToNameEnv bulkAddMode ownDefinition g amap a if tinstDeclaring.IsEmpty then nenv else { nenv with eUnqualifiedTyconDeclaringTypeInsts = nenv.eUnqualifiedTyconDeclaringTypeInsts.Add tcref tinstDeclaring }) +and private AddCSharpStyleExtensionMembersOfTypeToNameEnv (amap: Import.ImportMap) m nenv ty = + match tryTcrefOfAppTy amap.g ty with + | ValueSome tcref -> + AddCSharpStyleExtensionMembersOfTyconRefToNameEnv amap m nenv tcref + | _ -> + nenv + +and private AddCSharpStyleExtensionMembersOfTyconRefToNameEnv amap m nenv (tcref: TyconRef) = + let eIndexedExtensionMembers, eUnindexedExtensionMembers = + let ilStyleExtensionMeths = GetCSharpStyleIndexedExtensionMembersForTyconRef amap m tcref + ((nenv.eIndexedExtensionMembers, nenv.eUnindexedExtensionMembers), ilStyleExtensionMeths) ||> List.fold (fun (tab1, tab2) extMemInfo -> + match extMemInfo with + | Choice1Of2 (tcref, extMemInfo) -> tab1.Add (tcref, extMemInfo), tab2 + | Choice2Of2 extMemInfo -> tab1, extMemInfo :: tab2) + { nenv with + eIndexedExtensionMembers = eIndexedExtensionMembers + eUnindexedExtensionMembers = eUnindexedExtensionMembers } + /// Add any implied contents of a type definition to the environment. and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = @@ -1104,12 +1141,7 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef let flds = if isIL then [| |] else tcref.AllFieldsArray - let eIndexedExtensionMembers, eUnindexedExtensionMembers = - let ilStyleExtensionMeths = GetCSharpStyleIndexedExtensionMembersForTyconRef amap m tcref - ((nenv.eIndexedExtensionMembers, nenv.eUnindexedExtensionMembers), ilStyleExtensionMeths) ||> List.fold (fun (tab1, tab2) extMemInfo -> - match extMemInfo with - | Choice1Of2 (tcref, extMemInfo) -> tab1.Add (tcref, extMemInfo), tab2 - | Choice2Of2 extMemInfo -> tab1, extMemInfo :: tab2) + let nenv = AddCSharpStyleExtensionMembersOfTyconRefToNameEnv amap m nenv tcref let isILOrRequiredQualifiedAccess = isIL || (not ownDefinition && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute tcref.Attribs) let eFieldLabels = @@ -1165,9 +1197,7 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) { nenv with eFieldLabels = eFieldLabels eUnqualifiedItems = eUnqualifiedItems - ePatItems = ePatItems - eIndexedExtensionMembers = eIndexedExtensionMembers - eUnindexedExtensionMembers = eUnindexedExtensionMembers } + ePatItems = ePatItems } let nenv = if amap.g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index fb2d3252d02..b85fc070dab 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -667,6 +667,114 @@ let x = Equals(2.0, 3.0) (FSharpErrorSeverity.Error, 39, (4, 9, 4, 15), "The value or constructor 'Equals' is not defined.") |]) + [] + let ``Opened types do no allow unqualified access to C#-style extension methods - Error`` () = + let fsharpSource = + """ +open System.Runtime.CompilerServices + +module TestExtensions = + [] + type IntExtensions = + + [] + static member Test(_: int) = () + +open type TestExtensions.IntExtensions + +[] +let main _ = + Test(1) + 0 + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.CompileWithErrors(fsCmpl, [| + (FSharpErrorSeverity.Error, 39, (15, 5, 15, 9), + "The value or constructor 'Test' is not defined. Maybe you want one of the following: + Text + TestExtensions") + |]) + + [] + let ``Opened types do allow unqualified access to C#-style extension methods if type has no [] attribute`` () = + let fsharpSource = + """ +open System.Runtime.CompilerServices + +module TestExtensions = + type IntExtensions = + + [] + static member Test(_: int) = () + +open type TestExtensions.IntExtensions + +[] +let main _ = + Test(1) + 0 + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.Compile(fsCmpl) + + [] + let ``Opened types do allow unqualified access to members with no [] attribute`` () = + let fsharpSource = + """ +open System.Runtime.CompilerServices + +module TestExtensions = + [] + type IntExtensions = + + static member Test(_: int) = () + +open type TestExtensions.IntExtensions + +[] +let main _ = + Test(1) + 0 + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.Compile(fsCmpl) + + [] + let ``Opened types with C# style extension members are available for normal extension method lookup`` () = + let fsharpSource = + """ +open System.Runtime.CompilerServices + +module TestExtensions = + [] + type IntExtensions = + + [] + static member Test(_: int) = () + +open type TestExtensions.IntExtensions + +[] +let main _ = + let x = 1 + x.Test() + 0 + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) + + CompilerAssert.Compile(fsCmpl) + [] let ``An assembly with an event and field with the same name, favor the field`` () = let ilSource = From 4a33b19affe69d38f5b4da8894fe9ff29b46e93b Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 14 Jul 2020 16:11:13 -0700 Subject: [PATCH 46/89] Minor format --- src/fsharp/NameResolution.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index f43c1589309..3cbb980d4f2 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -453,9 +453,9 @@ let IsTypeUsedForCSharpStyleExtensionMembers g m ty = | _ -> false /// A 'plain' method is an extension method not interpreted as an extension method. -let IsMethInfoPlainCSharpStyleExtensionMember g m isEnclosingExtTy (minfo: MethInfo) = +let IsMethInfoPlainCSharpStyleExtensionMember g m isEnclExtTy (minfo: MethInfo) = // Method must be static, have 'Extension' attribute, must not be curried, must have at least one argument - isEnclosingExtTy && + isEnclExtTy && not minfo.IsInstance && not minfo.IsExtensionMember && (match minfo.NumArgs with [x] when x >= 1 -> true | _ -> false) && From 6b45af22fc5b59962e41f56bd3ba32ffa2b2b870 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 14 Jul 2020 17:22:19 -0700 Subject: [PATCH 47/89] Minor updates --- src/fsharp/NameResolution.fs | 1 + src/fsharp/TypeChecker.fs | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 3cbb980d4f2..52c683a9e96 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1201,6 +1201,7 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) let nenv = if amap.g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && + not isIL && TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true then if tcref.Typars(m).Length > 0 then failwith "nope" // TODO proper error let ty = generalizedTyconRef tcref diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 2a8185dc258..8796577ef57 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -374,7 +374,7 @@ let AddLocalTyconsAndReport tcSink scopem g amap m tycons env = CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env -/// Adjust the TcEnv to account for opening the set of modules, namespaces or static classes implied by an `open` declaration +/// Adjust the TcEnv to account for opening the set of modules or namespaces implied by an `open` declaration let OpenEntities tcSink g amap scopem root env mvvs openDeclaration = let env = if isNil mvvs then env else @@ -383,7 +383,7 @@ let OpenEntities tcSink g amap scopem root env mvvs openDeclaration = CallOpenDeclarationSink tcSink openDeclaration env -/// Adjust the TcEnv to account for opening the set of modules, namespaces or types implied by an `open` declaration +/// Adjust the TcEnv to account for opening a type implied by an `open type` declaration let OpenTypeContent tcSink g amap scopem env (typ: TType) openDeclaration = let env = { env with eNameResEnv = AddTypeContentsToNameEnv g amap env.eAccessRights scopem env.eNameResEnv typ } From d4f38725ba2a3526baa77608a29a5ba168f10e30 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 15 Jul 2020 19:25:57 -0700 Subject: [PATCH 48/89] Fixing nested types --- src/fsharp/NameResolution.fs | 135 +++++++++++------- src/fsharp/NameResolution.fsi | 5 +- src/fsharp/TypeChecker.fs | 11 +- .../Language/OpenTypeDeclarationTests.fs | 53 +++++-- 4 files changed, 136 insertions(+), 68 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 52c683a9e96..76b10f75f38 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -969,9 +969,10 @@ let LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo: TypeNa /// Get all the accessible nested types of an existing type. let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) (ad, optFilter, staticResInfo, checkForGenerated, m) ty = let g = amap.g + argsOfAppTy g ty, infoReader.GetPrimaryTypeHierarchy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> match ty with - | AppTy g (tcref, tinst) -> + | AppTy g (tcref, _) -> let tycon = tcref.Deref let mty = tycon.ModuleOrNamespaceType // No dotting through type generators to get to a nested type! @@ -985,7 +986,6 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( match optFilter with | Some nm -> LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo, tcref) - |> List.map (fun tcref -> (tcref, tinst)) | None -> #if !NO_EXTENSIONTYPING match tycon.TypeReprInfo with @@ -993,15 +993,14 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( [ for nestedType in info.ProvidedType.PApplyArray((fun sty -> sty.GetNestedTypes()), "GetNestedTypes", m) do let nestedTypeName = nestedType.PUntaint((fun t -> t.Name), m) yield! - LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nestedTypeName, staticResInfo, tcref) - |> List.map (fun tcref -> (tcref, tinst)) ] + LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nestedTypeName, staticResInfo, tcref) ] | _ -> #endif mty.TypesByAccessNames.Values |> List.choose (fun entity -> let tcref = tcref.NestedTyconRef entity - if IsEntityAccessible amap m ad tcref then Some (tcref, tinst) else None) + if IsEntityAccessible amap m ad tcref then Some tcref else None) | _ -> []) /// Make a type that refers to a nested type. @@ -1015,8 +1014,9 @@ let MakeNestedType (ncenv: NameResolver) (tinst: TType list) m (tcrefNested: Tyc /// Get all the accessible nested types of an existing type. let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, checkForGenerated, m) ty = - GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty - |> List.map (fun (tcref, tinst) -> MakeNestedType ncenv tinst m tcref) + let tinst, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty + tcrefsNested + |> List.map (MakeNestedType ncenv tinst m) let ChooseMethInfosForNameEnv g m ty (minfos: MethInfo list) = let isExtTy = IsTypeUsedForCSharpStyleExtensionMembers g m ty @@ -1106,13 +1106,12 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad m nenv ty = GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty - |> AddTyconRefsWithTypeInstToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv + |> AddTyconRefsWithDeclaringTypeInstToNameEnv BulkAdd.No false amap.g amap ad m false nenv -and private AddTyconRefsWithTypeInstToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tcrefsWithArgs: (TyconRef * TypeInst) list) = - let tcrefs = tcrefsWithArgs |> List.map (fun (tcref, _) -> tcref) +and private AddTyconRefsWithDeclaringTypeInstToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tinstDeclaring: TypeInst, tcrefs: TyconRef list) = let nenv = AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs - (nenv, tcrefsWithArgs) - ||> List.fold (fun nenv (tcref, tinstDeclaring) -> + (nenv, tcrefs) + ||> List.fold (fun nenv tcref -> if tinstDeclaring.IsEmpty then nenv else { nenv with eUnqualifiedTyconDeclaringTypeInsts = nenv.eUnqualifiedTyconDeclaringTypeInsts.Add tcref tinstDeclaring }) @@ -2069,9 +2068,9 @@ let CheckAllTyparsInferrable amap m item = /// ultimately calls ResolutionInfo.Method to record it for /// later use by Visual Studio. type ResolutionInfo = - | ResolutionInfo of (*entityPath, reversed*)(range * EntityRef) list * (*warnings/errors*)(ResultTyparChecker -> unit) + | ResolutionInfo of (*entityPath, reversed*)(range * EntityRef) list * (*warnings/errors*)(ResultTyparChecker -> unit) * tinstDeclaring: TypeInst - static member SendEntityPathToSink(sink, ncenv: NameResolver, nenv, occ, ad, ResolutionInfo(entityPath, warnings), typarChecker) = + static member SendEntityPathToSink(sink, ncenv: NameResolver, nenv, occ, ad, ResolutionInfo(entityPath, warnings, _), typarChecker) = entityPath |> List.iter (fun (m, eref: EntityRef) -> CheckEntityAttributes ncenv.g eref m |> CommitOperationResult CheckTyconAccessible ncenv.amap m ad eref |> ignore @@ -2084,17 +2083,23 @@ type ResolutionInfo = warnings typarChecker static member Empty = - ResolutionInfo([], (fun _ -> ())) + ResolutionInfo([], (fun _ -> ()), []) member x.AddEntity info = - let (ResolutionInfo(entityPath, warnings)) = x - ResolutionInfo(info :: entityPath, warnings) + let (ResolutionInfo(entityPath, warnings, tinstDeclaring)) = x + ResolutionInfo(info :: entityPath, warnings, tinstDeclaring) member x.AddWarning f = - let (ResolutionInfo(entityPath, warnings)) = x - ResolutionInfo(entityPath, (fun typarChecker -> f typarChecker; warnings typarChecker)) + let (ResolutionInfo(entityPath, warnings, tinstDeclaring)) = x + ResolutionInfo(entityPath, (fun typarChecker -> f typarChecker; warnings typarChecker), tinstDeclaring) + member x.AddDeclaringTypeInst tinst = + let (ResolutionInfo(entityPath, warnings, tinstDeclaring)) = x + ResolutionInfo(entityPath, warnings, tinstDeclaring @ tinst) + member x.DeclaringTypeInst = + match x with + | ResolutionInfo(tinstDeclaring=tinstDeclaring) -> tinstDeclaring /// Resolve ambiguities between types overloaded by generic arity, based on number of type arguments. /// Also check that we're not returning direct references to generated provided types. @@ -2122,13 +2127,14 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities let tcrefs = match tcrefs with - | ((_resInfo, tcref) :: _) when + | ((resInfo, tcref) :: _) when // multiple types tcrefs.Length > 1 && // no explicit type instantiation typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && // some type arguments required on all types (note sorted by typar count above) not (List.isEmpty (tcref.Typars m)) && + ((tcref.Typars m).Length - resInfo.DeclaringTypeInst.Length) > 0 && // plausible types have different arities (tcrefs |> Seq.distinctBy (fun (_, tcref) -> tcref.Typars(m).Length) |> Seq.length > 1) -> [ for (resInfo, tcref) in tcrefs do @@ -2445,7 +2451,10 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf let nestedSearchAccessible = match rest with | [] -> - let nestedTypes = GetNestedTypesOfType (ad, ncenv, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty + let tinstDeclaring, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty + let tcrefsNested = tcrefsNested |> List.map (fun tcrefNested -> (resInfo, tcrefNested)) + let tcrefsNested = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefsNested, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) + let nestedTypes = tcrefsNested |> List.map (fun (_, tcrefNested) -> MakeNestedType ncenv tinstDeclaring m tcrefNested) if isNil nestedTypes then NoResultsOrUsefulErrors else @@ -2642,30 +2651,34 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type /// An identifier has resolved to a type name in an expression (corresponding to one or more TyconRefs). /// Return either a set of constructors (later refined by overload resolution), or a set of TyconRefs. let ChooseUnqualifiedTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, resInfo: ResolutionInfo, tcrefs) = - let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) + let tcrefs = + tcrefs + |> List.map (fun tcref -> + match nenv.eUnqualifiedTyconDeclaringTypeInsts.TryFind tcref with + | None -> + (resInfo, tcref) + | Some tinst -> + (resInfo.AddDeclaringTypeInst tinst, tcref)) + |> List.filter (fun (resInfo, tcref) -> + typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || + typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length - resInfo.DeclaringTypeInst.Length) let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) + + let tys = + tcrefs + |> List.map (fun (resInfo, tcref) -> + match resInfo.DeclaringTypeInst with + | [] -> + (resInfo, FreshenTycon ncenv m tcref) + | tinstDeclaring -> + (resInfo, FreshenTyconWithDeclaringTypeInst ncenv m tcref tinstDeclaring)) + match typeNameResInfo.ResolutionFlag with | ResolveTypeNamesToCtors -> - let tys = - tcrefs - |> List.map (fun (resInfo, tcref) -> - match nenv.eUnqualifiedTyconDeclaringTypeInsts.TryFind tcref with - | None -> - (resInfo, FreshenTycon ncenv m tcref) - | Some tinst -> - (resInfo, FreshenTyconWithDeclaringTypeInst ncenv m tcref tinst)) tys - |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) - |> MapResults (fun (resInfo, item) -> (resInfo, item)) + |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) + |> MapResults (fun (resInfo, item) -> (resInfo, item)) | ResolveTypeNamesToTypeRefs -> - let tys = - tcrefs - |> List.map (fun (resInfo, tcref) -> - match nenv.eUnqualifiedTyconDeclaringTypeInsts.TryFind tcref with - | None -> - (resInfo, FreshenTycon ncenv m tcref) - | Some tinst -> - (resInfo, FreshenTyconWithDeclaringTypeInst ncenv m tcref tinst)) success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty])))) /// Resolve F# "A.B.C" syntax in expressions @@ -2700,12 +2713,12 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // The name is a type name and it has not been clobbered by some other name | true, Item.UnqualifiedType tcrefs -> - // Do not use type names from the environment if an explicit type instantiation is - // given and the number of type parameters do not match - let tcrefs = - tcrefs |> List.filter (fun tcref -> - typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || - typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length) + //// Do not use type names from the environment if an explicit type instantiation is + //// given and the number of type parameters do not match + //let tcrefs = + // tcrefs |> List.filter (fun tcref -> + // typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || + // typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length) let search = ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) match AtMostOneResult m search with @@ -3164,7 +3177,15 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full | [] -> match LookupTypeNameInEnvHaveArity fullyQualified id.idText staticResInfo.NumStaticArgs nenv with | Some res -> - let res = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities ([(ResolutionInfo.Empty, res)], typeNameResInfo, genOk, unionRanges m id.idRange) + let resInfo = + match fullyQualified with + | OpenQualified -> + match nenv.eUnqualifiedTyconDeclaringTypeInsts.TryFind res with + | Some tinst -> ResolutionInfo.Empty.AddDeclaringTypeInst tinst + | _ -> ResolutionInfo.Empty + | _ -> + ResolutionInfo.Empty + let res = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities ([(resInfo, res)], typeNameResInfo, genOk, unionRanges m id.idRange) assert (res.Length = 1) success res.Head | None -> @@ -3234,7 +3255,7 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full /// Resolve a long identifier representing a type and report it -let ResolveTypeLongIdent sink (ncenv: NameResolver) occurence fullyQualified nenv ad (lid: Ident list) staticResInfo genOk = +let ResolveTypeLongIdentAux sink (ncenv: NameResolver) occurence fullyQualified nenv ad (lid: Ident list) staticResInfo genOk = let m = rangeOfLid lid let res = match lid with @@ -3250,7 +3271,16 @@ let ResolveTypeLongIdent sink (ncenv: NameResolver) occurence fullyQualified nen let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv m tcref]) CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occurence, ad) | _ -> () - res |?> snd + res + +/// Resolve a long identifier representing a type and report it +let ResolveTypeLongIdent sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk = + let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk + (res |?> snd) + +let ResolveTypeLongIdentAndDeclaringTypeInst sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk = + let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk + (res |?> fun (resInfo, tcref) -> (resInfo.DeclaringTypeInst, tcref)) //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in records etc. @@ -3447,8 +3477,7 @@ let FreshenRecdFieldRef (ncenv: NameResolver) m (rfref: RecdFieldRef) = /// determine any valid members // // QUERY (instantiationGenerator cleanup): it would be really nice not to flow instantiationGenerator to here. -let private ResolveExprDotLongIdent (ncenv: NameResolver) m ad nenv ty (id: Ident) rest findFlag = - let typeNameResInfo = TypeNameResolutionInfo.Default +let private ResolveExprDotLongIdent (ncenv: NameResolver) m ad nenv ty (id: Ident) rest (typeNameResInfo: TypeNameResolutionInfo) findFlag = let adhocDotSearchAccessible = AtMostOneResult m (ResolveLongIdentInTypePrim ncenv nenv LookupKind.Expr ResolutionInfo.Empty 1 m ad id rest findFlag typeNameResInfo ty) match adhocDotSearchAccessible with | Exception _ -> @@ -3580,12 +3609,12 @@ let (|NonOverridable|_|) namedItem = /// Called for 'expression.Bar' - for VS IntelliSense, we can filter out static members from method groups /// Also called for 'GenericType.Bar' - for VS IntelliSense, we can filter out non-static members from method groups -let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv ty lid findFlag thisIsActuallyATyAppNotAnExpr = +let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv ty lid (staticResInfo: TypeNameResolutionInfo) findFlag thisIsActuallyATyAppNotAnExpr = let resolveExpr findFlag = let resInfo, item, rest = match lid with | id :: rest -> - ResolveExprDotLongIdent ncenv wholem ad nenv ty id rest findFlag + ResolveExprDotLongIdent ncenv wholem ad nenv ty id rest staticResInfo findFlag | _ -> error(InternalError("ResolveExprDotLongIdentAndComputeRange", wholem)) let itemRange = ComputeItemRange wholem lid rest resInfo, item, rest, itemRange diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index d40819b5d76..3c4d1745a8b 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -550,6 +550,9 @@ val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResol /// Resolve a long identifier to a type definition val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException +/// Resolve a long identifier to a type definition with declaring type instantiations. +val internal ResolveTypeLongIdentAndDeclaringTypeInst : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException + /// Resolve a long identifier to a field val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list @@ -583,7 +586,7 @@ type AfterResolution = val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * range * Ident list * AfterResolution /// Resolve a long identifier occurring in an expression position, qualified by a type. -val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> FindMemberFlag -> bool -> Item * range * Ident list * AfterResolution +val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> TypeNameResolutionInfo -> FindMemberFlag -> bool -> Item * range * Ident list * AfterResolution /// A generator of type instantiations used when no more specific type instantiation is known. val FakeInstantiationGenerator : range -> Typar list -> TType list diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 8796577ef57..a2abab7ecbb 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -4659,7 +4659,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | SynType.LongIdent(LongIdentWithDots(tc, _) as lidwd) -> let m = lidwd.Range let ad = env.eAccessRights - let tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let tinstDeclaring, tcref = ForceRaise(ResolveTypeLongIdentAndDeclaringTypeInst cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) match optKind, tcref.TypeOrMeasureKind with | Some TyparKind.Type, TyparKind.Measure -> error(Error(FSComp.SR.tcExpectedTypeNotUnitOfMeasure(), m)) @@ -4670,7 +4670,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | _, TyparKind.Measure -> TType_measure (Measure.Con tcref), tpenv | _, TyparKind.Type -> - TcTypeApp cenv newOk checkCxs occ env tpenv m tcref [] [] + TcTypeApp cenv newOk checkCxs occ env tpenv m tcref tinstDeclaring [] | SynType.App (StripParenTypes (SynType.LongIdent(LongIdentWithDots(tc, _))), _, args, _commas, _, postfix, m) -> let ad = env.eAccessRights @@ -5131,7 +5131,7 @@ and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty t if not (isAppTy cenv.g ty) then error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), mWholeTypeApp)) match ty with | TType_app(tcref, tinst) -> - let pathTypeArgs = List.truncate (max (tinst.Length - tcref.Typars(mWholeTypeApp).Length) 0) tinst + let pathTypeArgs = tinst |> List.takeWhile (not << isTyparTy cenv.g) TcTypeApp cenv newOk checkCxs occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -9584,7 +9584,8 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del // Report information about the whole expression including type arguments to VS let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId IgnoreOverrides true) otherDelayed + let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed + TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true) otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! @@ -10044,7 +10045,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela if isTyparTy cenv.g objExprTy then ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight cenv.g false objExprTy) - let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId findFlag false + let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false let mExprAndItem = unionRanges mObjExpr mItem let delayed = delayRest rest mExprAndItem delayed diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index b85fc070dab..4d707d93d68 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -370,15 +370,13 @@ module Test = let ``Open generic type and use nested types as unqualified`` () = let csharpSource = """ -using System; - namespace CSharpTest { - public static class Test + public class Test { public class NestedTest { - public T A() + public T B() { return default(T); } @@ -386,12 +384,16 @@ namespace CSharpTest public class NestedTest { - public U B() + public T A() { - return default(U); + return default(T); } } } + + public class Test + { + } } """ @@ -400,14 +402,30 @@ namespace CSharpTest namespace FSharpTest open System -open type CSharpTest.Test module Test = - let x = NestedTest() + + let x : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() + let y : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() + + let t1 = CSharpTest.Test() + + let t2 = CSharpTest.Test() + +open type CSharpTest.Test + +module Test2 = + + let x = NestedTest() let xb = x.B() - let y = NestedTest() + let y = NestedTest() let ya = y.A() + + let x1 = new NestedTest() + let x1b = x.B() + + """ let csCmpl = @@ -419,6 +437,23 @@ module Test = CompilerAssert.Compile(fsCmpl) + [] + let ``Open generic type and use nested types as unqualified 2`` () = + let fsharpSource = + """ +namespace FSharpTest + +open type System.Collections.Generic.List + +module Test = + let e2 = new Enumerator() + """ + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|]) + + CompilerAssert.Compile(fsCmpl) + [] let ``Using the 'open' declaration on a possible type identifier - Error`` () = let csharpSource = From 6eb8f07e587273bbb4821fc4ab1fd1a66ba7e06d Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 16 Jul 2020 12:37:51 -0700 Subject: [PATCH 49/89] Fixed nested types possibly --- src/fsharp/NameResolution.fs | 33 +++++++++++-------- src/fsharp/NameResolution.fsi | 2 +- src/fsharp/TypeChecker.fs | 12 +++---- .../Language/OpenTypeDeclarationTests.fs | 13 ++++++-- 4 files changed, 37 insertions(+), 23 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 76b10f75f38..4582f2702e1 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -743,11 +743,11 @@ let GeneralizeUnionCaseRef (ucref: UnionCaseRef) = /// Add type definitions to the sub-table of the environment indexed by name and arity -let AddTyconsByDemangledNameAndArity (bulkAddMode: BulkAdd) (tcrefs: TyconRef[]) (tab: LayeredMap) = +let AddTyconsByDemangledNameAndArity (bulkAddMode: BulkAdd) (tinstDeclaringCount: int) (tcrefs: TyconRef[]) (tab: LayeredMap) = if tcrefs.Length = 0 then tab else let entries = tcrefs - |> Array.map (fun tcref -> Construct.KeyTyconByDemangledNameAndArity tcref.LogicalName tcref.TyparsNoRange tcref) + |> Array.map (fun tcref -> Construct.KeyTyconByDemangledNameAndArity tcref.LogicalName (tcref.TyparsNoRange |> List.skip tinstDeclaringCount) tcref) match bulkAddMode with | BulkAdd.Yes -> tab.AddAndMarkAsCollapsible entries @@ -1105,15 +1105,22 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad m nenv ty = - GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty - |> AddTyconRefsWithDeclaringTypeInstToNameEnv BulkAdd.No false amap.g amap ad m false nenv + let tinst, tcrefs = GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty + let tcrefGroup = + tcrefs + |> List.groupBy (fun tcref -> tcref.LogicalName) + + (nenv, tcrefGroup) + ||> List.fold (fun nenv (_, tcrefs) -> + AddTyconRefsWithDeclaringTypeInstToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv (tinst, tcrefs)) and private AddTyconRefsWithDeclaringTypeInstToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tinstDeclaring: TypeInst, tcrefs: TyconRef list) = - let nenv = AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs - (nenv, tcrefs) - ||> List.fold (fun nenv tcref -> - if tinstDeclaring.IsEmpty then nenv - else { nenv with eUnqualifiedTyconDeclaringTypeInsts = nenv.eUnqualifiedTyconDeclaringTypeInsts.Add tcref tinstDeclaring }) + let nenv = + (nenv, tcrefs) + ||> List.fold (fun nenv tcref -> + if tinstDeclaring.IsEmpty then nenv + else { nenv with eUnqualifiedTyconDeclaringTypeInsts = nenv.eUnqualifiedTyconDeclaringTypeInsts.Add tcref tinstDeclaring }) + AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tinstDeclaring.Length tcrefs and private AddCSharpStyleExtensionMembersOfTypeToNameEnv (amap: Import.ImportMap) m nenv ty = match tryTcrefOfAppTy amap.g ty with @@ -1211,7 +1218,7 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) nenv /// Add a set of type definitions to the name resolution environment -and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs = +and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tinstDeclaringCount tcrefs = if isNil tcrefs then nenv else let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap ad m) nenv tcrefs // Add most of the contents of the tycons en-masse, then flatten the tables if we're opening a module or namespace @@ -1219,7 +1226,7 @@ and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs { env with eFullyQualifiedTyconsByDemangledNameAndArity = if root then - AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eFullyQualifiedTyconsByDemangledNameAndArity + AddTyconsByDemangledNameAndArity bulkAddMode tinstDeclaringCount tcrefs nenv.eFullyQualifiedTyconsByDemangledNameAndArity else nenv.eFullyQualifiedTyconsByDemangledNameAndArity eFullyQualifiedTyconsByAccessNames = @@ -1228,7 +1235,7 @@ and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs else nenv.eFullyQualifiedTyconsByAccessNames eTyconsByDemangledNameAndArity = - AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eTyconsByDemangledNameAndArity + AddTyconsByDemangledNameAndArity bulkAddMode tinstDeclaringCount tcrefs nenv.eTyconsByDemangledNameAndArity eTyconsByAccessNames = AddTyconByAccessNames bulkAddMode tcrefs nenv.eTyconsByAccessNames } @@ -1312,7 +1319,7 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai let tcref = modref.NestedTyconRef tycon if IsEntityAccessible amap m ad tcref then Some tcref else None) - let nenv = (nenv, tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap ad m false + let nenv = (nenv, 0, tcrefs) |||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap ad m false let vrefs = mty.AllValsAndMembers.ToList() |> List.choose (fun x -> if IsAccessible ad x.Accessibility then TryMkValRefInModRef modref x else None) diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 3c4d1745a8b..1f66d68ffe9 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -230,7 +230,7 @@ val internal AddValRefToNameEnv : NameResolutionEnv -> ValRef val internal AddActivePatternResultTagsToNameEnv : ActivePatternInfo -> NameResolutionEnv -> TType -> range -> NameResolutionEnv /// Add a list of type definitions to the name resolution environment -val internal AddTyconRefsToNameEnv : BulkAdd -> bool -> TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> TyconRef list -> NameResolutionEnv +val internal AddTyconRefsToNameEnv : BulkAdd -> bool -> TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> tinstDeclaringCount: int -> TyconRef list -> NameResolutionEnv /// Add an F# exception definition to the name resolution environment val internal AddExceptionDeclsToNameEnv : BulkAdd -> NameResolutionEnv -> TyconRef -> NameResolutionEnv diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index a2abab7ecbb..b7ad9df83dc 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -361,7 +361,7 @@ let AddLocalExnDefnAndReport tcSink scopem env (exnc: Tycon) = /// Add a list of type definitions to TcEnv let AddLocalTyconRefs ownDefinition g amap m tcrefs env = if isNil tcrefs then env else - { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.No ownDefinition g amap env.eAccessRights m false env.eNameResEnv tcrefs } + { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.No ownDefinition g amap env.eAccessRights m false env.eNameResEnv 0 tcrefs } /// Add a list of type definitions to TcEnv let AddLocalTycons g amap m (tycons: Tycon list) env = @@ -418,7 +418,7 @@ let AddNonLocalCcu g amap scopem env assemblyName (ccu: CcuThunk, internalsVisib let env = AddRootModuleOrNamespaceRefs g amap scopem env modrefs let env = if isNil tcrefs then env else - { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.Yes false g amap env.eAccessRights scopem true env.eNameResEnv tcrefs } + { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.Yes false g amap env.eAccessRights scopem true env.eNameResEnv 0 tcrefs } env /// Adjust the TcEnv to account for a fully processed "namespace" declaration in this file @@ -429,7 +429,7 @@ let AddLocalRootModuleOrNamespace tcSink g amap scopem env (mtyp: ModuleOrNamesp let tcrefs = mtyp.TypeAndExceptionDefinitions |> List.map mkLocalTyconRef let env = AddRootModuleOrNamespaceRefs g amap scopem env modrefs let env = { env with - eNameResEnv = if isNil tcrefs then env.eNameResEnv else AddTyconRefsToNameEnv BulkAdd.No false g amap env.eAccessRights scopem true env.eNameResEnv tcrefs + eNameResEnv = if isNil tcrefs then env.eNameResEnv else AddTyconRefsToNameEnv BulkAdd.No false g amap env.eAccessRights scopem true env.eNameResEnv 0 tcrefs eUngeneralizableItems = addFreeItemOfModuleTy mtyp env.eUngeneralizableItems } CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env @@ -4675,9 +4675,9 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | SynType.App (StripParenTypes (SynType.LongIdent(LongIdentWithDots(tc, _))), _, args, _commas, _, postfix, m) -> let ad = env.eAccessRights - let tcref = + let tinstDeclaring, tcref = let tyResInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length - ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No + ResolveTypeLongIdentAndDeclaringTypeInst cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No |> ForceRaise match optKind, tcref.TypeOrMeasureKind with @@ -4692,7 +4692,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | _, TyparKind.Type -> if postfix && tcref.Typars m |> List.exists (fun tp -> match tp.Kind with TyparKind.Measure -> true | _ -> false) then error(Error(FSComp.SR.tcInvalidUnitsOfMeasurePrefix(), m)) - TcTypeApp cenv newOk checkCxs occ env tpenv m tcref [] args + TcTypeApp cenv newOk checkCxs occ env tpenv m tcref tinstDeclaring args | _, TyparKind.Measure -> match args, postfix with | [arg], true -> diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 4d707d93d68..17e1c014ebb 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -417,15 +417,22 @@ open type CSharpTest.Test module Test2 = let x = NestedTest() - let xb = x.B() + let xb : byte = x.B() let y = NestedTest() - let ya = y.A() + let ya : byte = y.A() let x1 = new NestedTest() - let x1b = x.B() + let x1b : byte = x1.B() + let y1 = new NestedTest() + let y1a : byte = y1.A() + let x2 : NestedTest = new NestedTest() + let x2b : byte = x2.B() + + let y2 : NestedTest = new NestedTest() + let y2a : byte = y2.A() """ let csCmpl = From 4d763b9917a5630bdfe68c51f609056598c55dd2 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 16 Jul 2020 15:54:45 -0700 Subject: [PATCH 50/89] Trying to fix it --- src/fsharp/NameResolution.fs | 28 ++++++++++++++-------------- src/fsharp/NameResolution.fsi | 2 +- src/fsharp/PrettyNaming.fs | 13 +++++++++++-- src/fsharp/TypeChecker.fs | 9 ++++----- src/fsharp/TypedTree.fs | 10 +++++----- 5 files changed, 35 insertions(+), 27 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 4582f2702e1..32ae5894247 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -743,11 +743,11 @@ let GeneralizeUnionCaseRef (ucref: UnionCaseRef) = /// Add type definitions to the sub-table of the environment indexed by name and arity -let AddTyconsByDemangledNameAndArity (bulkAddMode: BulkAdd) (tinstDeclaringCount: int) (tcrefs: TyconRef[]) (tab: LayeredMap) = +let AddTyconsByDemangledNameAndArity (bulkAddMode: BulkAdd) (tcrefs: TyconRef[]) (tab: LayeredMap) = if tcrefs.Length = 0 then tab else let entries = tcrefs - |> Array.map (fun tcref -> Construct.KeyTyconByDemangledNameAndArity tcref.LogicalName (tcref.TyparsNoRange |> List.skip tinstDeclaringCount) tcref) + |> Array.map (fun tcref -> Construct.KeyTyconByDecodedName tcref.LogicalName tcref) match bulkAddMode with | BulkAdd.Yes -> tab.AddAndMarkAsCollapsible entries @@ -929,7 +929,7 @@ let LookupTypeNameInEntityHaveArity nm (staticResInfo: TypeNameResolutionStaticA let LookupTypeNameNoArity nm (byDemangledNameAndArity: LayeredMap) (byAccessNames: LayeredMultiMap) = match TryDemangleGenericNameAndPos nm with | ValueSome pos -> - let demangled = DecodeGenericTypeName pos nm + let demangled = DecodeGenericTypeNameWithPos pos nm match byDemangledNameAndArity.TryGetValue demangled with | true, res -> [res] | _ -> @@ -940,8 +940,8 @@ let LookupTypeNameNoArity nm (byDemangledNameAndArity: LayeredMap List.fold (fun nenv tcref -> if tinstDeclaring.IsEmpty then nenv else { nenv with eUnqualifiedTyconDeclaringTypeInsts = nenv.eUnqualifiedTyconDeclaringTypeInsts.Add tcref tinstDeclaring }) - AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tinstDeclaring.Length tcrefs + AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs and private AddCSharpStyleExtensionMembersOfTypeToNameEnv (amap: Import.ImportMap) m nenv ty = match tryTcrefOfAppTy amap.g ty with @@ -1218,7 +1218,7 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) nenv /// Add a set of type definitions to the name resolution environment -and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tinstDeclaringCount tcrefs = +and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs = if isNil tcrefs then nenv else let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap ad m) nenv tcrefs // Add most of the contents of the tycons en-masse, then flatten the tables if we're opening a module or namespace @@ -1226,7 +1226,7 @@ and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tinstD { env with eFullyQualifiedTyconsByDemangledNameAndArity = if root then - AddTyconsByDemangledNameAndArity bulkAddMode tinstDeclaringCount tcrefs nenv.eFullyQualifiedTyconsByDemangledNameAndArity + AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eFullyQualifiedTyconsByDemangledNameAndArity else nenv.eFullyQualifiedTyconsByDemangledNameAndArity eFullyQualifiedTyconsByAccessNames = @@ -1235,7 +1235,7 @@ and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tinstD else nenv.eFullyQualifiedTyconsByAccessNames eTyconsByDemangledNameAndArity = - AddTyconsByDemangledNameAndArity bulkAddMode tinstDeclaringCount tcrefs nenv.eTyconsByDemangledNameAndArity + AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eTyconsByDemangledNameAndArity eTyconsByAccessNames = AddTyconByAccessNames bulkAddMode tcrefs nenv.eTyconsByAccessNames } @@ -1319,7 +1319,7 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai let tcref = modref.NestedTyconRef tycon if IsEntityAccessible amap m ad tcref then Some tcref else None) - let nenv = (nenv, 0, tcrefs) |||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap ad m false + let nenv = (nenv, tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap ad m false let vrefs = mty.AllValsAndMembers.ToList() |> List.choose (fun x -> if IsAccessible ad x.Accessibility then TryMkValRefInModRef modref x else None) @@ -1493,7 +1493,7 @@ let inline (+++) res1 query2 = AtMostOneResultQuery query2 res1 let LookupTypeNameInEnvHaveArity fq nm numTyArgs (nenv: NameResolutionEnv) = let key = match TryDemangleGenericNameAndPos nm with - | ValueSome pos -> DecodeGenericTypeName pos nm + | ValueSome pos -> DecodeGenericTypeNameWithPos pos nm | _ -> NameArityPair(nm, numTyArgs) match nenv.TyconsByDemangledNameAndArity(fq).TryFind key with @@ -3079,7 +3079,7 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv: NameResolver) (typeNameResInf | tcref :: _ -> success tcref | [] -> let suggestTypes (addToBuffer: string -> unit) = - for e in tcref.ModuleOrNamespaceType.TypesByDemangledNameAndArity id.idRange do + for e in tcref.ModuleOrNamespaceType.TypesByDemangledNameAndArity do addToBuffer e.Value.DisplayName raze (UndefinedName(depth, FSComp.SR.undefinedNameType, id, suggestTypes)) @@ -3099,7 +3099,7 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv: NameResolver) (typeNameResInf | _ :: _ -> tcrefs |> CollectAtMostOneResult (fun (resInfo, tcref) -> ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk (depth+1) m tcref id2 rest2) | [] -> let suggestTypes (addToBuffer: string -> unit) = - for e in tcref.ModuleOrNamespaceType.TypesByDemangledNameAndArity id.idRange do + for e in tcref.ModuleOrNamespaceType.TypesByDemangledNameAndArity do addToBuffer e.Value.DisplayName raze (UndefinedName(depth, FSComp.SR.undefinedNameType, id, suggestTypes)) @@ -3163,7 +3163,7 @@ let rec private ResolveTypeLongIdentInModuleOrNamespace sink nenv (ncenv: NameRe | _ :: _ -> tcrefs |> CollectResults (fun tcref -> ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk (depth+1) m tcref id2 rest2) | [] -> let suggestTypes (addToBuffer: string -> unit) = - for e in modref.ModuleOrNamespaceType.TypesByDemangledNameAndArity id.idRange do + for e in modref.ModuleOrNamespaceType.TypesByDemangledNameAndArity do addToBuffer e.Value.DisplayName raze (UndefinedName(depth, FSComp.SR.undefinedNameType, id, suggestTypes)) diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 1f66d68ffe9..3c4d1745a8b 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -230,7 +230,7 @@ val internal AddValRefToNameEnv : NameResolutionEnv -> ValRef val internal AddActivePatternResultTagsToNameEnv : ActivePatternInfo -> NameResolutionEnv -> TType -> range -> NameResolutionEnv /// Add a list of type definitions to the name resolution environment -val internal AddTyconRefsToNameEnv : BulkAdd -> bool -> TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> tinstDeclaringCount: int -> TyconRef list -> NameResolutionEnv +val internal AddTyconRefsToNameEnv : BulkAdd -> bool -> TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> TyconRef list -> NameResolutionEnv /// Add an F# exception definition to the name resolution environment val internal AddExceptionDeclsToNameEnv : BulkAdd -> NameResolutionEnv -> TyconRef -> NameResolutionEnv diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index 89c841ea40b..ea5ba7fdd42 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -512,9 +512,13 @@ let TryDemangleGenericNameAndPos (n: string) = else ValueNone -type NameArityPair = NameArityPair of string * int +type NameArityPair = NameArityPair of string * int with -let DecodeGenericTypeName pos (mangledName: string) = + member x.Arity = + match x with + | NameArityPair(_, arity) -> arity + +let DecodeGenericTypeNameWithPos pos (mangledName: string) = let res = mangledName.Substring(0, pos) let num = mangledName.Substring(pos+1, mangledName.Length - pos - 1) NameArityPair(res, int32 num) @@ -527,6 +531,11 @@ let DemangleGenericTypeName (mangledName: string) = | ValueSome pos -> DemangleGenericTypeNameWithPos pos mangledName | _ -> mangledName +let DecodeGenericTypeName (mangledName: string) = + match TryDemangleGenericNameAndPos mangledName with + | ValueSome pos -> DecodeGenericTypeNameWithPos pos mangledName + | _ -> NameArityPair(mangledName, 0) + let private chopStringTo (s: string) (c: char) = match s.IndexOf c with | -1 -> s diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index b7ad9df83dc..58fd6e1bfd3 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -361,7 +361,7 @@ let AddLocalExnDefnAndReport tcSink scopem env (exnc: Tycon) = /// Add a list of type definitions to TcEnv let AddLocalTyconRefs ownDefinition g amap m tcrefs env = if isNil tcrefs then env else - { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.No ownDefinition g amap env.eAccessRights m false env.eNameResEnv 0 tcrefs } + { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.No ownDefinition g amap env.eAccessRights m false env.eNameResEnv tcrefs } /// Add a list of type definitions to TcEnv let AddLocalTycons g amap m (tycons: Tycon list) env = @@ -418,7 +418,7 @@ let AddNonLocalCcu g amap scopem env assemblyName (ccu: CcuThunk, internalsVisib let env = AddRootModuleOrNamespaceRefs g amap scopem env modrefs let env = if isNil tcrefs then env else - { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.Yes false g amap env.eAccessRights scopem true env.eNameResEnv 0 tcrefs } + { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.Yes false g amap env.eAccessRights scopem true env.eNameResEnv tcrefs } env /// Adjust the TcEnv to account for a fully processed "namespace" declaration in this file @@ -429,7 +429,7 @@ let AddLocalRootModuleOrNamespace tcSink g amap scopem env (mtyp: ModuleOrNamesp let tcrefs = mtyp.TypeAndExceptionDefinitions |> List.map mkLocalTyconRef let env = AddRootModuleOrNamespaceRefs g amap scopem env modrefs let env = { env with - eNameResEnv = if isNil tcrefs then env.eNameResEnv else AddTyconRefsToNameEnv BulkAdd.No false g amap env.eAccessRights scopem true env.eNameResEnv 0 tcrefs + eNameResEnv = if isNil tcrefs then env.eNameResEnv else AddTyconRefsToNameEnv BulkAdd.No false g amap env.eAccessRights scopem true env.eNameResEnv tcrefs eUngeneralizableItems = addFreeItemOfModuleTy mtyp env.eUngeneralizableItems } CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env @@ -5131,7 +5131,7 @@ and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty t if not (isAppTy cenv.g ty) then error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), mWholeTypeApp)) match ty with | TType_app(tcref, tinst) -> - let pathTypeArgs = tinst |> List.takeWhile (not << isTyparTy cenv.g) + let pathTypeArgs = tinst |> List.takeWhile (fun ty -> not (isTyparTy cenv.g ty || isMeasureTy cenv.g ty)) TcTypeApp cenv newOk checkCxs occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -9575,7 +9575,6 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del match delayed with | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: (DelayedDotLookup (longId, mLongId)) :: otherDelayed) -> - // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index f0aeb5bf7bb..3519c598aa5 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -1912,9 +1912,9 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en /// Get a table of types defined within this module, namespace or type. The /// table is indexed by both name and generic arity. This means that for generic /// types "List`1", the entry (List, 1) will be present. - member mtyp.TypesByDemangledNameAndArity m = + member mtyp.TypesByDemangledNameAndArity = cacheOptByref &tyconsByDemangledNameAndArityCache (fun () -> - LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc: Tycon) -> Construct.KeyTyconByDemangledNameAndArity tc.LogicalName (tc.Typars m) tc) |> List.toArray)) + LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc: Tycon) -> Construct.KeyTyconByDecodedName tc.LogicalName tc) |> List.toArray)) /// Get a table of types defined within this module, namespace or type. The /// table is indexed by both name and, for generic types, also by mangled name. @@ -5297,9 +5297,9 @@ type Construct() = static let taccessPublic = TAccess [] - /// Key a Tycon or TyconRef by demangled name and arity - static member KeyTyconByDemangledNameAndArity<'T> (nm: string) (typars: Typar list) (x: 'T) : KeyValuePair = - KeyValuePair(NameArityPair(DemangleGenericTypeName nm, typars.Length), x) + /// Key a Tycon or TyconRef by decoded name + static member KeyTyconByDecodedName<'T> (nm: string) (x: 'T) : KeyValuePair = + KeyValuePair(DecodeGenericTypeName nm, x) /// Key a Tycon or TyconRef by both mangled and demangled name. /// Generic types can be accessed either by 'List' or 'List`1'. From a14c8050cea6ed4b8cfce3cbfdb9e8d31f82d187 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 16 Jul 2020 16:41:39 -0700 Subject: [PATCH 51/89] Some cleanup --- src/fsharp/NameResolution.fs | 69 ++++++++++++++++++----------------- src/fsharp/NameResolution.fsi | 9 +++-- src/fsharp/TypeChecker.fs | 30 +++++++-------- 3 files changed, 55 insertions(+), 53 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 32ae5894247..51568610e50 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -334,8 +334,8 @@ type NameResolutionEnv = /// Values, functions, methods and other items available by unqualified name eUnqualifiedItems: UnqualifiedItems - /// Type instantiations that are associated with an unqualified type item - eUnqualifiedTyconDeclaringTypeInsts: TyconRefMap + /// Enclosing type instantiations that are associated with an unqualified type item + eUnqualifiedEnclosingTypeInsts: TyconRefMap /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap @@ -395,7 +395,7 @@ type NameResolutionEnv = eFullyQualifiedModulesAndNamespaces = Map.empty eFieldLabels = Map.empty eUnqualifiedItems = LayeredMap.Empty - eUnqualifiedTyconDeclaringTypeInsts = TyconRefMap.Empty + eUnqualifiedEnclosingTypeInsts = TyconRefMap.Empty ePatItems = Map.empty eTyconsByAccessNames = LayeredMultiMap.Empty eTyconsByDemangledNameAndArity = LayeredMap.Empty @@ -833,6 +833,7 @@ type TypeNameResolutionInfo = member x.StaticArgsInfo = match x with TypeNameResolutionInfo(_, staticResInfo) -> staticResInfo member x.ResolutionFlag = match x with TypeNameResolutionInfo(flag, _) -> flag member x.DropStaticArgsInfo = match x with TypeNameResolutionInfo(flag2, _) -> TypeNameResolutionInfo(flag2, TypeNameResolutionStaticArgsInfo.Indefinite) + member x.NumStaticArgs = x.StaticArgsInfo.NumStaticArgs /// A flag which indicates if direct references to generated provided types are allowed. Normally these /// are disallowed. @@ -1112,14 +1113,14 @@ and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad (nenv, tcrefGroup) ||> List.fold (fun nenv (_, tcrefs) -> - AddTyconRefsWithDeclaringTypeInstToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv (tinst, tcrefs)) + AddTyconRefsWithEnclosingTypeInstToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv (tinst, tcrefs)) -and private AddTyconRefsWithDeclaringTypeInstToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tinstDeclaring: TypeInst, tcrefs: TyconRef list) = +and private AddTyconRefsWithEnclosingTypeInstToNameEnv bulkAddMode ownDefinition g amap ad m root nenv (tinstEnclosing: TypeInst, tcrefs: TyconRef list) = let nenv = (nenv, tcrefs) ||> List.fold (fun nenv tcref -> - if tinstDeclaring.IsEmpty then nenv - else { nenv with eUnqualifiedTyconDeclaringTypeInsts = nenv.eUnqualifiedTyconDeclaringTypeInsts.Add tcref tinstDeclaring }) + if tinstEnclosing.IsEmpty then nenv + else { nenv with eUnqualifiedEnclosingTypeInsts = nenv.eUnqualifiedEnclosingTypeInsts.Add tcref tinstEnclosing }) AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs and private AddCSharpStyleExtensionMembersOfTypeToNameEnv (amap: Import.ImportMap) m nenv ty = @@ -1387,11 +1388,11 @@ let FreshenTycon (ncenv: NameResolver) m (tcref: TyconRef) = improvedTy /// Convert a reference to a named type into a type that includes -/// a set of declaring type arguments and a fresh set of inference type variables for the type parameters. -let FreshenTyconWithDeclaringTypeInst (ncenv: NameResolver) m (tcrefNested: TyconRef) (tinstDeclaring: TypeInst) = - let tps = ncenv.InstantiationGenerator m (tcrefNested.Typars m) - let tinstNested = List.skip tinstDeclaring.Length tps - let improvedTy = ncenv.g.decompileType tcrefNested (tinstDeclaring @ tinstNested) +/// a set of enclosing type instantiations and a fresh set of inference type variables for the type parameters. +let FreshenTyconWithEnclosingTypeInst (ncenv: NameResolver) m (tinstEnclosing: TypeInst) (tcref: TyconRef) = + let tps = ncenv.InstantiationGenerator m (tcref.Typars m) + let tinst = List.skip tinstEnclosing.Length tps + let improvedTy = ncenv.g.decompileType tcref (tinstEnclosing @ tinst) improvedTy /// Convert a reference to a union case into a UnionCaseInfo that includes @@ -2075,7 +2076,7 @@ let CheckAllTyparsInferrable amap m item = /// ultimately calls ResolutionInfo.Method to record it for /// later use by Visual Studio. type ResolutionInfo = - | ResolutionInfo of (*entityPath, reversed*)(range * EntityRef) list * (*warnings/errors*)(ResultTyparChecker -> unit) * tinstDeclaring: TypeInst + | ResolutionInfo of (*entityPath, reversed*)(range * EntityRef) list * (*warnings/errors*)(ResultTyparChecker -> unit) * tinstEnclosing: TypeInst static member SendEntityPathToSink(sink, ncenv: NameResolver, nenv, occ, ad, ResolutionInfo(entityPath, warnings, _), typarChecker) = entityPath |> List.iter (fun (m, eref: EntityRef) -> @@ -2093,20 +2094,20 @@ type ResolutionInfo = ResolutionInfo([], (fun _ -> ()), []) member x.AddEntity info = - let (ResolutionInfo(entityPath, warnings, tinstDeclaring)) = x - ResolutionInfo(info :: entityPath, warnings, tinstDeclaring) + let (ResolutionInfo(entityPath, warnings, tinstEnclosing)) = x + ResolutionInfo(info :: entityPath, warnings, tinstEnclosing) member x.AddWarning f = - let (ResolutionInfo(entityPath, warnings, tinstDeclaring)) = x - ResolutionInfo(entityPath, (fun typarChecker -> f typarChecker; warnings typarChecker), tinstDeclaring) + let (ResolutionInfo(entityPath, warnings, tinstEnclosing)) = x + ResolutionInfo(entityPath, (fun typarChecker -> f typarChecker; warnings typarChecker), tinstEnclosing) - member x.AddDeclaringTypeInst tinst = - let (ResolutionInfo(entityPath, warnings, tinstDeclaring)) = x - ResolutionInfo(entityPath, warnings, tinstDeclaring @ tinst) + member x.WithEnclosingTypeInst tinstEnclosing = + let (ResolutionInfo(entityPath, warnings, _)) = x + ResolutionInfo(entityPath, warnings, tinstEnclosing) - member x.DeclaringTypeInst = + member x.EnclosingTypeInst = match x with - | ResolutionInfo(tinstDeclaring=tinstDeclaring) -> tinstDeclaring + | ResolutionInfo(tinstEnclosing=tinstEnclosing) -> tinstEnclosing /// Resolve ambiguities between types overloaded by generic arity, based on number of type arguments. /// Also check that we're not returning direct references to generated provided types. @@ -2140,8 +2141,7 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities // no explicit type instantiation typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && // some type arguments required on all types (note sorted by typar count above) - not (List.isEmpty (tcref.Typars m)) && - ((tcref.Typars m).Length - resInfo.DeclaringTypeInst.Length) > 0 && + ((tcref.Typars m).Length - resInfo.EnclosingTypeInst.Length) > 0 && // plausible types have different arities (tcrefs |> Seq.distinctBy (fun (_, tcref) -> tcref.Typars(m).Length) |> Seq.length > 1) -> [ for (resInfo, tcref) in tcrefs do @@ -2661,24 +2661,25 @@ let ChooseUnqualifiedTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident let tcrefs = tcrefs |> List.map (fun tcref -> - match nenv.eUnqualifiedTyconDeclaringTypeInsts.TryFind tcref with + match nenv.eUnqualifiedEnclosingTypeInsts.TryFind tcref with | None -> (resInfo, tcref) | Some tinst -> - (resInfo.AddDeclaringTypeInst tinst, tcref)) + (resInfo.WithEnclosingTypeInst tinst, tcref)) |> List.filter (fun (resInfo, tcref) -> typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || - typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length - resInfo.DeclaringTypeInst.Length) + typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length) + let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) let tys = tcrefs |> List.map (fun (resInfo, tcref) -> - match resInfo.DeclaringTypeInst with + match resInfo.EnclosingTypeInst with | [] -> (resInfo, FreshenTycon ncenv m tcref) - | tinstDeclaring -> - (resInfo, FreshenTyconWithDeclaringTypeInst ncenv m tcref tinstDeclaring)) + | tinstEnclosing -> + (resInfo, FreshenTyconWithEnclosingTypeInst ncenv m tinstEnclosing tcref)) match typeNameResInfo.ResolutionFlag with | ResolveTypeNamesToCtors -> @@ -3187,8 +3188,8 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full let resInfo = match fullyQualified with | OpenQualified -> - match nenv.eUnqualifiedTyconDeclaringTypeInsts.TryFind res with - | Some tinst -> ResolutionInfo.Empty.AddDeclaringTypeInst tinst + match nenv.eUnqualifiedEnclosingTypeInsts.TryFind res with + | Some tinst -> ResolutionInfo.Empty.WithEnclosingTypeInst tinst | _ -> ResolutionInfo.Empty | _ -> ResolutionInfo.Empty @@ -3285,9 +3286,9 @@ let ResolveTypeLongIdent sink ncenv occurence fullyQualified nenv ad lid staticR let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk (res |?> snd) -let ResolveTypeLongIdentAndDeclaringTypeInst sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk = +let ResolveTypeLongIdentAndEnclosingTypeInst sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk = let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk - (res |?> fun (resInfo, tcref) -> (resInfo.DeclaringTypeInst, tcref)) + (res |?> fun (resInfo, tcref) -> (resInfo.EnclosingTypeInst, tcref)) //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in records etc. diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 3c4d1745a8b..a4f422cd5e4 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -160,8 +160,8 @@ type NameResolutionEnv = /// Values and Data Tags available by unqualified name eUnqualifiedItems: LayeredMap - /// Type arguments that are associated with an unqualified type item - eUnqualifiedTyconDeclaringTypeInsts: TyconRefMap + /// Enclosing type instantiations that are associated with an unqualified type item + eUnqualifiedEnclosingTypeInsts: TyconRefMap /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap @@ -286,6 +286,7 @@ type TypeNameResolutionInfo = | TypeNameResolutionInfo of TypeNameResolutionFlag * TypeNameResolutionStaticArgsInfo static member Default : TypeNameResolutionInfo static member ResolveToTypeRefs : TypeNameResolutionStaticArgsInfo -> TypeNameResolutionInfo + member NumStaticArgs : int /// Represents the kind of the occurrence when reporting a name in name resolution [] @@ -550,8 +551,8 @@ val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResol /// Resolve a long identifier to a type definition val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException -/// Resolve a long identifier to a type definition with declaring type instantiations. -val internal ResolveTypeLongIdentAndDeclaringTypeInst : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException +/// Resolve a long identifier to a type definition with enclosing type instantiations. +val internal ResolveTypeLongIdentAndEnclosingTypeInst : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException /// Resolve a long identifier to a field val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 58fd6e1bfd3..bcf081367eb 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -4659,7 +4659,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | SynType.LongIdent(LongIdentWithDots(tc, _) as lidwd) -> let m = lidwd.Range let ad = env.eAccessRights - let tinstDeclaring, tcref = ForceRaise(ResolveTypeLongIdentAndDeclaringTypeInst cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let tinstEnclosing, tcref = ForceRaise(ResolveTypeLongIdentAndEnclosingTypeInst cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) match optKind, tcref.TypeOrMeasureKind with | Some TyparKind.Type, TyparKind.Measure -> error(Error(FSComp.SR.tcExpectedTypeNotUnitOfMeasure(), m)) @@ -4670,14 +4670,14 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | _, TyparKind.Measure -> TType_measure (Measure.Con tcref), tpenv | _, TyparKind.Type -> - TcTypeApp cenv newOk checkCxs occ env tpenv m tcref tinstDeclaring [] + TcTypeApp cenv newOk checkCxs occ env tpenv m tcref tinstEnclosing [] | SynType.App (StripParenTypes (SynType.LongIdent(LongIdentWithDots(tc, _))), _, args, _commas, _, postfix, m) -> let ad = env.eAccessRights - let tinstDeclaring, tcref = + let tinstEnclosing, tcref = let tyResInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length - ResolveTypeLongIdentAndDeclaringTypeInst cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No + ResolveTypeLongIdentAndEnclosingTypeInst cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No |> ForceRaise match optKind, tcref.TypeOrMeasureKind with @@ -4692,7 +4692,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | _, TyparKind.Type -> if postfix && tcref.Typars m |> List.exists (fun tp -> match tp.Kind with TyparKind.Measure -> true | _ -> false) then error(Error(FSComp.SR.tcInvalidUnitsOfMeasurePrefix(), m)) - TcTypeApp cenv newOk checkCxs occ env tpenv m tcref tinstDeclaring args + TcTypeApp cenv newOk checkCxs occ env tpenv m tcref tinstEnclosing args | _, TyparKind.Measure -> match args, postfix with | [arg], true -> @@ -5126,12 +5126,12 @@ and TcTypeOrMeasureAndRecover optKind cenv newOk checkCxs occ env tpenv ty = and TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty = TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkCxs occ env tpenv ty -and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty tyargs = +and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty enclTyArgNum tyargs = let ty = convertToTypeWithMetadataIfPossible cenv.g ty if not (isAppTy cenv.g ty) then error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), mWholeTypeApp)) match ty with | TType_app(tcref, tinst) -> - let pathTypeArgs = tinst |> List.takeWhile (fun ty -> not (isTyparTy cenv.g ty || isMeasureTy cenv.g ty)) + let pathTypeArgs = tinst |> List.truncate (tinst.Length - enclTyArgNum) TcTypeApp cenv newOk checkCxs occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -9416,13 +9416,13 @@ and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) dela let ad = env.eAccessRights let typeNameResInfo = GetLongIdentTypeNameInfo delayed let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId - TcItemThen cenv overallTy env tpenv nameResolutionResult delayed + TcItemThen cenv overallTy env tpenv nameResolutionResult typeNameResInfo.NumStaticArgs delayed //------------------------------------------------------------------------- // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) delayed = +and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) enclTyArgNum delayed = let g = cenv.g let delayed = delayRest rest mItem delayed let ad = env.eAccessRights @@ -9578,17 +9578,17 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty enclTyArgNum tyargs // Report information about the whole expression including type arguments to VS let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed - TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true) otherDelayed + TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true) (argsOfAppTy cenv.g ty).Length otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tyargs + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty enclTyArgNum tyargs let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) @@ -9660,7 +9660,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: (DelayedApp (_, arg, mExprAndArg)) :: otherDelayed) -> - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy enclTyArgNum tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_EXTENSIONTYPING @@ -9681,7 +9681,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: otherDelayed) -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy enclTyArgNum tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) @@ -9821,7 +9821,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | ((DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs)) :: (DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty enclTyArgNum tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty From dc8152c9c1d84cfedd962dc8f9f43efe88a7398b Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 16 Jul 2020 17:37:29 -0700 Subject: [PATCH 52/89] More cleanup --- src/fsharp/NameResolution.fs | 56 +++++++++++++++++++----------------- src/fsharp/TypeChecker.fs | 16 +++++------ 2 files changed, 38 insertions(+), 34 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 51568610e50..2fb2c9c4808 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2657,19 +2657,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type /// An identifier has resolved to a type name in an expression (corresponding to one or more TyconRefs). /// Return either a set of constructors (later refined by overload resolution), or a set of TyconRefs. -let ChooseUnqualifiedTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, resInfo: ResolutionInfo, tcrefs) = - let tcrefs = - tcrefs - |> List.map (fun tcref -> - match nenv.eUnqualifiedEnclosingTypeInsts.TryFind tcref with - | None -> - (resInfo, tcref) - | Some tinst -> - (resInfo.WithEnclosingTypeInst tinst, tcref)) - |> List.filter (fun (resInfo, tcref) -> - typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || - typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length) - +let ChooseUnqualifiedTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, tcrefs) = let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) let tys = @@ -2689,11 +2677,23 @@ let ChooseUnqualifiedTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident | ResolveTypeNamesToTypeRefs -> success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty])))) +/// Resolves the given tycons as if they used in an unqualified environment. +/// For each tycon, return resolution info that could contain enclosing type instantations. +let ResolveUnqualifiedTyconRefs nenv tcrefs = + let resInfo = ResolutionInfo.Empty + + tcrefs + |> List.map (fun tcref -> + match nenv.eUnqualifiedEnclosingTypeInsts.TryFind tcref with + | None -> + (resInfo, tcref) + | Some tinst -> + (resInfo.WithEnclosingTypeInst tinst, tcref)) + /// Resolve F# "A.B.C" syntax in expressions /// Not all of the sequence will necessarily be swallowed, i.e. we return some identifiers /// that may represent further actions, e.g. further lookups. let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified m ad nenv (typeNameResInfo: TypeNameResolutionInfo) (id: Ident) (rest: Ident list) isOpenDecl = - let resInfo = ResolutionInfo.Empty let canSuggestThisItem (item:Item) = // All items can be suggested except nameof when it comes from FSharp.Core.dll and the nameof feature is not enabled match item with @@ -2721,14 +2721,16 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // The name is a type name and it has not been clobbered by some other name | true, Item.UnqualifiedType tcrefs -> - //// Do not use type names from the environment if an explicit type instantiation is - //// given and the number of type parameters do not match - //let tcrefs = - // tcrefs |> List.filter (fun tcref -> - // typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || - // typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length) + // Do not use type names from the environment if an explicit type instantiation is + // given and the number of type parameters do not match + let tcrefs = + tcrefs + |> ResolveUnqualifiedTyconRefs nenv + |> List.filter (fun (resInfo, tcref) -> + typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || + typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length) - let search = ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) + let search = ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) match AtMostOneResult m search with | Result _ as res -> let resInfo, item = ForceRaise res @@ -2756,12 +2758,14 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified let innerSearch = // Check if it's a type name, e.g. a constructor call or a type instantiation let ctorSearch = - let tcrefs = LookupTypeNameInEnvMaybeHaveArity fullyQualified id.idText typeNameResInfo nenv - ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) + let tcrefs = + LookupTypeNameInEnvMaybeHaveArity fullyQualified id.idText typeNameResInfo nenv + |> ResolveUnqualifiedTyconRefs nenv + ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) let implicitOpSearch() = if IsMangledOpName id.idText then - success [(resInfo, Item.ImplicitOp(id, ref None))] + success [(ResolutionInfo.Empty, Item.ImplicitOp(id, ref None))] else NoResultsOrUsefulErrors @@ -2835,7 +2839,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified if isNil tcrefs then NoResultsOrUsefulErrors else match rest with | id2 :: rest2 -> - let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) let tcrefs = let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.Indefinite) CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) @@ -2852,7 +2856,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified match nenv.eUnqualifiedItems.TryGetValue id.idText with | true, Item.UnqualifiedType _ | false, _ -> NoResultsOrUsefulErrors - | true, res -> OneSuccess (resInfo, FreshenUnqualifiedItem ncenv m res, rest) + | true, res -> OneSuccess (ResolutionInfo.Empty, FreshenUnqualifiedItem ncenv m res, rest) moduleSearch ad () +++ tyconSearch ad +++ envSearch diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index bcf081367eb..9c535159da9 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -5126,12 +5126,12 @@ and TcTypeOrMeasureAndRecover optKind cenv newOk checkCxs occ env tpenv ty = and TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty = TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkCxs occ env tpenv ty -and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty enclTyArgNum tyargs = +and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty numPathTypeArgs tyargs = let ty = convertToTypeWithMetadataIfPossible cenv.g ty if not (isAppTy cenv.g ty) then error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), mWholeTypeApp)) match ty with | TType_app(tcref, tinst) -> - let pathTypeArgs = tinst |> List.truncate (tinst.Length - enclTyArgNum) + let pathTypeArgs = tinst |> List.truncate (tinst.Length - numPathTypeArgs) TcTypeApp cenv newOk checkCxs occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -9422,7 +9422,7 @@ and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) dela // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) enclTyArgNum delayed = +and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) numPathTypeArgs delayed = let g = cenv.g let delayed = delayRest rest mItem delayed let ad = env.eAccessRights @@ -9578,7 +9578,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) enc // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty enclTyArgNum tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty numPathTypeArgs tyargs // Report information about the whole expression including type arguments to VS let item = Item.Types(nm, [ty]) @@ -9588,7 +9588,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) enc | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty enclTyArgNum tyargs + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty numPathTypeArgs tyargs let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) @@ -9660,7 +9660,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) enc | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: (DelayedApp (_, arg, mExprAndArg)) :: otherDelayed) -> - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy enclTyArgNum tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy numPathTypeArgs tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_EXTENSIONTYPING @@ -9681,7 +9681,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) enc | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: otherDelayed) -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy enclTyArgNum tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy numPathTypeArgs tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) @@ -9821,7 +9821,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) enc | ((DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs)) :: (DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty enclTyArgNum tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty numPathTypeArgs tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty From c4dcdaea7d2e68be6eb1a8abb0609a3a2b0dd245 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 16 Jul 2020 20:22:33 -0700 Subject: [PATCH 53/89] Partial --- src/fsharp/NameResolution.fs | 6 +- src/fsharp/TypeChecker.fs | 2 +- .../Language/OpenTypeDeclarationTests.fs | 92 +++++++++++++++++++ 3 files changed, 96 insertions(+), 4 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 2fb2c9c4808..e05aa9e533d 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2458,10 +2458,10 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf let nestedSearchAccessible = match rest with | [] -> - let tinstDeclaring, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty + let tinstEnclosing, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty let tcrefsNested = tcrefsNested |> List.map (fun tcrefNested -> (resInfo, tcrefNested)) let tcrefsNested = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefsNested, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) - let nestedTypes = tcrefsNested |> List.map (fun (_, tcrefNested) -> MakeNestedType ncenv tinstDeclaring m tcrefNested) + let nestedTypes = tcrefsNested |> List.map (fun (_, tcrefNested) -> MakeNestedType ncenv tinstEnclosing m tcrefNested) if isNil nestedTypes then NoResultsOrUsefulErrors else @@ -3099,7 +3099,7 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv: NameResolver) (typeNameResInf let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, TypeNameResolutionStaticArgsInfo.Indefinite, tcref) if isNil tcrefs then NoResultsOrUsefulErrors else let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) - let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo.DropStaticArgsInfo, genOk, m) + let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, genOk, m) match tcrefs with | _ :: _ -> tcrefs |> CollectAtMostOneResult (fun (resInfo, tcref) -> ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk (depth+1) m tcref id2 rest2) | [] -> diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 9c535159da9..136d47783c8 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -9584,7 +9584,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) num let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed - TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true) (argsOfAppTy cenv.g ty).Length otherDelayed + TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true) typeNameResInfo.NumStaticArgs otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 17e1c014ebb..9bce76386ca 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -461,6 +461,98 @@ module Test = CompilerAssert.Compile(fsCmpl) + [] + let ``Open generic type and use nested types as unqualified 3`` () = + let csharpSource = + """ +namespace CSharpTest +{ + public class Test + { + public class NestedTest + { + public class NestedNestedTest + { + public T A() + { + return default(T); + } + } + + public class NestedNestedTest + { + public U B() + { + return default(U); + } + } + } + + public class NestedTest + { + public class NestedNestedTest + { + public U C() + { + return default(U); + } + } + + public class NestedNestedTest + { + public R D() + { + return default(R); + } + } + } + } +} + """ + + let fsharpSource = + """ +namespace FSharpTest + +open System + +module Test = + +// let a : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() + // let b : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() + + let c : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() +// let d : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() + +// let e : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() +// let f : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() + +//open type CSharpTest.Test + +//module Test2 = + +// let a : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() +// let aa : byte = x.A() + +// let b : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() +// let bb : float = b.B() + +// let c : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() +// let cc : float = c.C() + +// let d : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() +// let dd : int = d.D() + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) + + CompilerAssert.Compile(fsCmpl) + [] let ``Using the 'open' declaration on a possible type identifier - Error`` () = let csharpSource = From dca1c6ffe0841f8aee1d724ea095d24b377bb862 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Fri, 17 Jul 2020 13:15:24 -0700 Subject: [PATCH 54/89] Partially working --- src/fsharp/NameResolution.fs | 37 +++++++++++++------ src/fsharp/TypeChecker.fs | 2 +- .../Language/OpenTypeDeclarationTests.fs | 26 ++++++------- 3 files changed, 39 insertions(+), 26 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index e05aa9e533d..45f5ad31fb2 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2383,6 +2383,12 @@ let GetRecordLabelsForType g nenv ty = result.Add k |> ignore result +let ResolveNestedTypes (ncenv: NameResolver) (resInfo: ResolutionInfo) ad nm (typeNameResInfo: TypeNameResolutionInfo) m ty = + let tinstEnclosing, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty + let tcrefsNested = tcrefsNested |> List.map (fun tcrefNested -> (resInfo, tcrefNested)) + let tcrefsNested = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefsNested, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) + tcrefsNested |> List.map (fun (_, tcrefNested) -> MakeNestedType ncenv tinstEnclosing m tcrefNested) + // REVIEW: this shows up on performance logs. Consider for example endless resolutions of "List.map" to // the empty set of results, or "x.Length" for a list or array type. This indicates it could be worth adding a cache here. let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInfo: ResolutionInfo) depth m ad (id: Ident) (rest: Ident list) findFlag (typeNameResInfo: TypeNameResolutionInfo) ty = @@ -2458,10 +2464,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf let nestedSearchAccessible = match rest with | [] -> - let tinstEnclosing, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty - let tcrefsNested = tcrefsNested |> List.map (fun tcrefNested -> (resInfo, tcrefNested)) - let tcrefsNested = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefsNested, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) - let nestedTypes = tcrefsNested |> List.map (fun (_, tcrefNested) -> MakeNestedType ncenv tinstEnclosing m tcrefNested) + let nestedTypes = ResolveNestedTypes ncenv resInfo ad nm typeNameResInfo m ty if isNil nestedTypes then NoResultsOrUsefulErrors else @@ -2473,7 +2476,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | ResolveTypeNamesToTypeRefs -> OneSuccess (resInfo, Item.Types (nm, nestedTypes), rest) | id2 :: rest2 -> - let nestedTypes = GetNestedTypesOfType (ad, ncenv, Some nm, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty + let nestedTypes = ResolveNestedTypes ncenv resInfo ad nm (TypeNameResolutionInfo.ResolveToTypeRefs TypeNameResolutionStaticArgsInfo.Indefinite) m ty ResolveLongIdentInNestedTypes ncenv nenv lookupKind resInfo (depth+1) id m ad id2 rest2 findFlag typeNameResInfo nestedTypes match nestedSearchAccessible with @@ -2536,12 +2539,17 @@ let ResolveLongIdentInType sink ncenv nenv lookupKind m ad id findFlag typeNameR ResolutionInfo.SendEntityPathToSink (sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) item, rest -let private ResolveLongIdentInTyconRef (ncenv: NameResolver) nenv lookupKind resInfo depth m ad id rest typeNameResInfo tcref = +let private ResolveLongIdentInTyconRef (ncenv: NameResolver) nenv lookupKind (resInfo: ResolutionInfo) depth m ad id rest typeNameResInfo tcref = #if !NO_EXTENSIONTYPING // No dotting through type generators to get to a member! CheckForDirectReferenceToGeneratedType (tcref, PermitDirectReferenceToGeneratedType.No, m) #endif - let ty = FreshenTycon ncenv m tcref + let ty = + match resInfo.EnclosingTypeInst with + | [] -> + FreshenTycon ncenv m tcref + | tinstEnclosing -> + FreshenTyconWithEnclosingTypeInst ncenv m tinstEnclosing tcref ty |> ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad id rest IgnoreOverrides typeNameResInfo let private ResolveLongIdentInTyconRefs atMostOne (ncenv: NameResolver) nenv lookupKind depth m ad id rest typeNameResInfo idRange tcrefs = @@ -2657,7 +2665,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type /// An identifier has resolved to a type name in an expression (corresponding to one or more TyconRefs). /// Return either a set of constructors (later refined by overload resolution), or a set of TyconRefs. -let ChooseUnqualifiedTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, tcrefs) = +let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, tcrefs) = let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) let tys = @@ -2730,7 +2738,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length) - let search = ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) + let search = ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) match AtMostOneResult m search with | Result _ as res -> let resInfo, item = ForceRaise res @@ -2761,7 +2769,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified let tcrefs = LookupTypeNameInEnvMaybeHaveArity fullyQualified id.idText typeNameResInfo nenv |> ResolveUnqualifiedTyconRefs nenv - ChooseUnqualifiedTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) + ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) let implicitOpSearch() = if IsMangledOpName id.idText then @@ -2836,12 +2844,17 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // This seems strange since we would expect in the vast majority of cases tcrefs is empty here. let tyconSearch ad () = let tcrefs = LookupTypeNameInEnvNoArity fullyQualified id.idText nenv + if isNil tcrefs then NoResultsOrUsefulErrors else match rest with | id2 :: rest2 -> - let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) + let tcrefs = + tcrefs + |> ResolveUnqualifiedTyconRefs nenv + |> List.filter (fun (resInfo, tcref) -> + typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && + tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length = 0) let tcrefs = - let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.Indefinite) CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Expr 1 m ad id2 rest2 typeNameResInfo id.idRange tcrefs | _ -> diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 136d47783c8..23a89af7541 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -9584,7 +9584,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) num let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed - TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true) typeNameResInfo.NumStaticArgs otherDelayed + TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true) (argsOfAppTy g ty).Length otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 9bce76386ca..0e38adc543a 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -516,32 +516,32 @@ namespace FSharpTest open System -module Test = +//module Test = // let a : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() - // let b : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() +// let b : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() - let c : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() +// let c : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() // let d : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() // let e : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() // let f : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() -//open type CSharpTest.Test +open type CSharpTest.Test -//module Test2 = +module Test2 = -// let a : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() -// let aa : byte = x.A() + // let a = NestedTest.NestedNestedTest() + // let aa : byte = a.A() -// let b : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() -// let bb : float = b.B() + let b : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + let bb : float = b.B() -// let c : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() -// let cc : float = c.C() + //let c : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + //let cc : float = c.C() -// let d : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() -// let dd : int = d.D() + //let d : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + //let dd : int = d.D() """ let csCmpl = From 29220ea6f001f313b222af7ad360ec98824b1388 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Fri, 17 Jul 2020 22:20:42 -0700 Subject: [PATCH 55/89] Fixed nested types --- src/fsharp/NameResolution.fs | 49 +++++++++++-------- src/fsharp/NameResolution.fsi | 6 +-- src/fsharp/TypeChecker.fs | 32 ++++++------ .../Language/OpenTypeDeclarationTests.fs | 46 ++++++++++++----- 4 files changed, 81 insertions(+), 52 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 45f5ad31fb2..d612a6aa0d6 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1062,9 +1062,20 @@ let ChooseEventInfosForNameEnv g ty (einfos: EventInfo list) = KeyValuePair(einfo.EventName, Item.Event einfo) } +/// Add content from a type. +/// Rules: +/// 1. Add nested types. +/// 2. Add C# style extension members. +/// 3. Add extention methods. +/// 4. Add extension properties. +/// 5. Add events. +/// 6. Add fields. +/// 7. Add properies. +/// 8. Add methods. let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) + let nenv = AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty let nenv = AddCSharpStyleExtensionMembersOfTypeToNameEnv amap m nenv ty // The order of items matter such as intrinsic members will always be favored over extension members of the same name. @@ -1102,8 +1113,7 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n |> ChooseMethInfosForNameEnv g m ty |] - let nenv = { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } - AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty + { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad m nenv ty = let tinst, tcrefs = GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty @@ -1139,7 +1149,7 @@ and private AddCSharpStyleExtensionMembersOfTyconRefToNameEnv amap m nenv (tcref | Choice2Of2 extMemInfo -> tab1, extMemInfo :: tab2) { nenv with eIndexedExtensionMembers = eIndexedExtensionMembers - eUnindexedExtensionMembers = eUnindexedExtensionMembers } + eUnindexedExtensionMembers = eUnindexedExtensionMembers } /// Add any implied contents of a type definition to the environment. and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = @@ -2131,7 +2141,7 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities // remove later duplicates (if we've opened the same module more than once) |> List.distinctBy (fun (_, tcref) -> tcref.Stamp) // List.sortBy is a STABLE sort (the order matters!) - |> List.sortBy (fun (_, tcref) -> tcref.Typars(m).Length) + |> List.sortBy (fun (resInfo, tcref) -> tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length) let tcrefs = match tcrefs with @@ -2743,7 +2753,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | Result _ as res -> let resInfo, item = ForceRaise res ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - Some(item, rest) + Some(item, rest, resInfo.EnclosingTypeInst) | Exception e -> typeError <- Some e; None | true, res -> @@ -2755,8 +2765,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // Do not resolve `nameof` if the feature is unsupported, even if it is FSharp.Core None else - Some (fresh, rest) - | _ -> Some (fresh, rest) + Some (fresh, rest, []) + | _ -> Some (fresh, rest, []) | _ -> None @@ -2813,7 +2823,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified ForceRaise failingCase ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - item, rest + item, rest, resInfo.EnclosingTypeInst // A compound identifier. @@ -2832,7 +2842,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | _ -> false if ValIsInEnv id.idText then - nenv.eUnqualifiedItems.[id.idText], rest + nenv.eUnqualifiedItems.[id.idText], rest, [] else // 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. @@ -2848,12 +2858,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified if isNil tcrefs then NoResultsOrUsefulErrors else match rest with | id2 :: rest2 -> - let tcrefs = - tcrefs - |> ResolveUnqualifiedTyconRefs nenv - |> List.filter (fun (resInfo, tcref) -> - typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && - tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length = 0) + let tcrefs = ResolveUnqualifiedTyconRefs nenv tcrefs let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Expr 1 m ad id2 rest2 typeNameResInfo id.idRange tcrefs @@ -2909,7 +2914,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified ForceRaise failingCase ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - item, rest + item, rest, resInfo.EnclosingTypeInst let ResolveExprLongIdent sink (ncenv: NameResolver) m ad nenv typeNameResInfo lid = match lid with @@ -3241,9 +3246,13 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full | FullyQualified -> NoResultsOrUsefulErrors | OpenQualified -> - match LookupTypeNameInEnvHaveArity fullyQualified id.idText staticResInfo.NumStaticArgs nenv with + match LookupTypeNameInEnvHaveArity fullyQualified id.idText 0 nenv with | Some tcref when IsEntityAccessible ncenv.amap m2 ad tcref -> let resInfo = ResolutionInfo.Empty.AddEntity(id.idRange, tcref) + let resInfo = + match nenv.eUnqualifiedEnclosingTypeInsts.TryFind tcref with + | Some tinstEnclosing -> resInfo.WithEnclosingTypeInst tinstEnclosing + | _ -> resInfo OneResult (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk 1 m2 tcref id2 rest2) | _ -> NoResultsOrUsefulErrors @@ -3574,7 +3583,7 @@ type AfterResolution = /// /// Called for 'TypeName.Bar' - for VS IntelliSense, we can filter out instance members from method groups let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv typeNameResInfo lid = - let item1, rest = ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid + let item1, rest, tinstEnclosing = ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid let itemRange = ComputeItemRange wholem lid rest let item = FilterMethodGroups ncenv itemRange item1 true @@ -3622,7 +3631,7 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso callSink (item, emptyTyparInst) AfterResolution.DoNothing - item, itemRange, rest, afterResolution + item, itemRange, rest, tinstEnclosing, afterResolution let (|NonOverridable|_|) namedItem = match namedItem with @@ -3685,7 +3694,7 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes callSink (unrefinedItem, emptyTyparInst) AfterResolution.DoNothing - item, itemRange, rest, afterResolution + item, itemRange, rest, resInfo.EnclosingTypeInst, afterResolution //------------------------------------------------------------------------- diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index a4f422cd5e4..2968ea20aee 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -558,7 +558,7 @@ val internal ResolveTypeLongIdentAndEnclosingTypeInst : TcResultsSink -> NameRes val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list /// Resolve a long identifier occurring in an expression position -val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * Ident list +val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * Ident list * TypeInst /// Resolve a (possibly incomplete) long identifier to a loist of possible class or record fields val internal ResolvePartialLongIdentToClassOrRecdFields : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> bool -> Item list @@ -584,10 +584,10 @@ type AfterResolution = | RecordResolution of Item option * (TyparInst -> unit) * (MethInfo * PropInfo option * TyparInst -> unit) * (unit -> unit) /// Resolve a long identifier occurring in an expression position. -val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * range * Ident list * AfterResolution +val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * range * Ident list * TypeInst * AfterResolution /// Resolve a long identifier occurring in an expression position, qualified by a type. -val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> TypeNameResolutionInfo -> FindMemberFlag -> bool -> Item * range * Ident list * AfterResolution +val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> TypeNameResolutionInfo -> FindMemberFlag -> bool -> Item * range * Ident list * TypeInst * AfterResolution /// A generator of type instantiations used when no more specific type instantiation is known. val FakeInstantiationGenerator : range -> Typar list -> TType list diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 23a89af7541..5e6b2191c97 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3201,7 +3201,7 @@ let (|JoinRelation|_|) cenv env (e: SynExpr) = let isOpName opName vref s = (s = opName) && match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default [ident(opName, m)] with - | Item.Value vref2, [] -> valRefEq cenv.g vref vref2 + | Item.Value vref2, [], _ -> valRefEq cenv.g vref vref2 | _ -> false match e with @@ -5126,12 +5126,11 @@ and TcTypeOrMeasureAndRecover optKind cenv newOk checkCxs occ env tpenv ty = and TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty = TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkCxs occ env tpenv ty -and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty numPathTypeArgs tyargs = +and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp ty pathTypeArgs tyargs = let ty = convertToTypeWithMetadataIfPossible cenv.g ty if not (isAppTy cenv.g ty) then error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), mWholeTypeApp)) match ty with - | TType_app(tcref, tinst) -> - let pathTypeArgs = tinst |> List.truncate (tinst.Length - numPathTypeArgs) + | TType_app(tcref, _) -> TcTypeApp cenv newOk checkCxs occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -9416,13 +9415,13 @@ and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) dela let ad = env.eAccessRights let typeNameResInfo = GetLongIdentTypeNameInfo delayed let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId - TcItemThen cenv overallTy env tpenv nameResolutionResult typeNameResInfo.NumStaticArgs delayed + TcItemThen cenv overallTy env tpenv nameResolutionResult delayed //------------------------------------------------------------------------- // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) numPathTypeArgs delayed = +and TcItemThen cenv overallTy env tpenv (item, mItem, rest, pathTypeArgs, afterResolution) delayed = let g = cenv.g let delayed = delayRest rest mItem delayed let ad = env.eAccessRights @@ -9576,19 +9575,20 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) num match delayed with | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: (DelayedDotLookup (longId, mLongId)) :: otherDelayed) -> // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs - // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args + // is a fresh instantiation for tcref. TcNestedTypeApplicatioen will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty numPathTypeArgs tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty pathTypeArgs tyargs // Report information about the whole expression including type arguments to VS let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed - TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true) (argsOfAppTy g ty).Length otherDelayed + let item, mItem, rest, _, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true + TcItemThen cenv overallTy env tpenv (item, mItem, rest, (argsOfAppTy g ty), afterResolution) otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty numPathTypeArgs tyargs + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty pathTypeArgs tyargs let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) @@ -9660,7 +9660,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) num | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: (DelayedApp (_, arg, mExprAndArg)) :: otherDelayed) -> - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy numPathTypeArgs tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy pathTypeArgs tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_EXTENSIONTYPING @@ -9681,7 +9681,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) num | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: otherDelayed) -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy numPathTypeArgs tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy pathTypeArgs tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) @@ -9821,7 +9821,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) num | ((DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs)) :: (DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty numPathTypeArgs tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty pathTypeArgs tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty @@ -10044,7 +10044,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela if isTyparTy cenv.g objExprTy then ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight cenv.g false objExprTy) - let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false + let item, mItem, rest, _, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false let mExprAndItem = unionRanges mObjExpr mItem let delayed = delayRest rest mExprAndItem delayed @@ -15288,12 +15288,12 @@ module TcExceptionDeclarations = match reprIdOpt with | Some longId -> match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default longId with - | Item.ExnCase exnc, [] -> + | Item.ExnCase exnc, [], _ -> CheckTyconAccessible cenv.amap m env.eAccessRights exnc |> ignore if not (isNil args') then errorR (Error(FSComp.SR.tcExceptionAbbreviationsShouldNotHaveArgumentList(), m)) TExnAbbrevRepr exnc - | Item.CtorGroup(_, meths), [] -> + | Item.CtorGroup(_, meths), [], _ -> // REVIEW: check this really is an exception type match args' with | [] -> () diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 0e38adc543a..89235d7d1aa 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -516,32 +516,52 @@ namespace FSharpTest open System -//module Test = +module Test = -// let a : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() -// let b : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() + let a : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() + let b : CSharpTest.Test.NestedTest = CSharpTest.Test.NestedTest() -// let c : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() -// let d : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() + let c : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() + let d : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() -// let e : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() -// let f : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() + let e : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() + let f : CSharpTest.Test.NestedTest.NestedNestedTest = CSharpTest.Test.NestedTest.NestedNestedTest() open type CSharpTest.Test module Test2 = - // let a = NestedTest.NestedNestedTest() - // let aa : byte = a.A() + let a : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + let aa : byte = a.A() let b : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() let bb : float = b.B() - //let c : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() - //let cc : float = c.C() + let c : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + let cc : float = c.C() + + let d : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + let dd : int = d.D() + +open type NestedTest + +module Test3 = + + let a : NestedNestedTest = NestedNestedTest() + let aa : byte = a.A() + + let b : NestedNestedTest = NestedNestedTest() + let bb : float = b.B() + +open type NestedTest + +module Test4 = + + let c : NestedNestedTest = NestedNestedTest() + let cc : float = c.C() - //let d : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() - //let dd : int = d.D() + let d : NestedNestedTest = NestedNestedTest() + let dd : int = d.D() """ let csCmpl = From baee9d1de47885765484e355fbefd224e905c3b3 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Sat, 18 Jul 2020 01:23:58 -0700 Subject: [PATCH 56/89] Fixing tests --- src/fsharp/NameResolution.fs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index d612a6aa0d6..d11483953d3 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2158,7 +2158,7 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities let resInfo = resInfo.AddWarning (fun _typarChecker -> errorR(Error(FSComp.SR.nrTypeInstantiationNeededToDisambiguateTypesWithSameName(tcref.DisplayName, tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))) yield (resInfo, tcref) ] - | [(resInfo, tcref)] when typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && not (List.isEmpty (tcref.Typars m)) && typeNameResInfo.ResolutionFlag = ResolveTypeNamesToTypeRefs -> + | [(resInfo, tcref)] when typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && ((tcref.Typars m).Length - resInfo.EnclosingTypeInst.Length) > 0 && typeNameResInfo.ResolutionFlag = ResolveTypeNamesToTypeRefs -> let resInfo = resInfo.AddWarning (fun (ResultTyparChecker typarChecker) -> if not (typarChecker()) then @@ -2556,10 +2556,8 @@ let private ResolveLongIdentInTyconRef (ncenv: NameResolver) nenv lookupKind (re #endif let ty = match resInfo.EnclosingTypeInst with - | [] -> - FreshenTycon ncenv m tcref - | tinstEnclosing -> - FreshenTyconWithEnclosingTypeInst ncenv m tinstEnclosing tcref + | [] -> FreshenTycon ncenv m tcref + | tinstEnclosing -> FreshenTyconWithEnclosingTypeInst ncenv m tinstEnclosing tcref ty |> ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad id rest IgnoreOverrides typeNameResInfo let private ResolveLongIdentInTyconRefs atMostOne (ncenv: NameResolver) nenv lookupKind depth m ad id rest typeNameResInfo idRange tcrefs = @@ -2610,7 +2608,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type | id2 :: rest2 -> let tcrefs = - let typeNameResInfo = TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs, TypeNameResolutionStaticArgsInfo.Indefinite) + let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs typeNameResInfo.StaticArgsInfo CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Expr (depth+1) m ad id2 rest2 typeNameResInfo id.idRange tcrefs @@ -2695,7 +2693,7 @@ let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameR | ResolveTypeNamesToTypeRefs -> success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty])))) -/// Resolves the given tycons as if they used in an unqualified environment. +/// Resolves the given tycons. /// For each tycon, return resolution info that could contain enclosing type instantations. let ResolveUnqualifiedTyconRefs nenv tcrefs = let resInfo = ResolutionInfo.Empty @@ -2860,6 +2858,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | id2 :: rest2 -> let tcrefs = ResolveUnqualifiedTyconRefs nenv tcrefs let tcrefs = + let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs typeNameResInfo.StaticArgsInfo CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Expr 1 m ad id2 rest2 typeNameResInfo id.idRange tcrefs | _ -> From d756a50e14f6d9f8b6f0d97638b150992440aa0d Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 21 Jul 2020 16:20:50 -0700 Subject: [PATCH 57/89] Removed NumStaticArgs --- src/fsharp/NameResolution.fs | 1 - src/fsharp/NameResolution.fsi | 1 - 2 files changed, 2 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index d11483953d3..a67d2aa04b8 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -833,7 +833,6 @@ type TypeNameResolutionInfo = member x.StaticArgsInfo = match x with TypeNameResolutionInfo(_, staticResInfo) -> staticResInfo member x.ResolutionFlag = match x with TypeNameResolutionInfo(flag, _) -> flag member x.DropStaticArgsInfo = match x with TypeNameResolutionInfo(flag2, _) -> TypeNameResolutionInfo(flag2, TypeNameResolutionStaticArgsInfo.Indefinite) - member x.NumStaticArgs = x.StaticArgsInfo.NumStaticArgs /// A flag which indicates if direct references to generated provided types are allowed. Normally these /// are disallowed. diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 2968ea20aee..b66a125c5a0 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -286,7 +286,6 @@ type TypeNameResolutionInfo = | TypeNameResolutionInfo of TypeNameResolutionFlag * TypeNameResolutionStaticArgsInfo static member Default : TypeNameResolutionInfo static member ResolveToTypeRefs : TypeNameResolutionStaticArgsInfo -> TypeNameResolutionInfo - member NumStaticArgs : int /// Represents the kind of the occurrence when reporting a name in name resolution [] From a315ffabb30daccf82d8e6838e18667d9fc80b82 Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 21 Jul 2020 16:43:12 -0700 Subject: [PATCH 58/89] Rename AddEntties/OpenEntities to AddModuleOrNamespaceRefs/OpenModuleOrNamespaceRefs --- src/fsharp/NameResolution.fs | 6 +++--- src/fsharp/NameResolution.fsi | 2 +- src/fsharp/TypeChecker.fs | 10 +++++----- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index a67d2aa04b8..88cf168e96a 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1347,15 +1347,15 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai // open M1 // // The list contains [M1b; M1a] -and AddEntitiesContentsToNameEnv g amap ad m root nenv modrefs = - (modrefs, nenv) ||> List.foldBack (fun modref acc -> AddEntityContentsToNameEnv g amap ad m root acc modref) +and AddModuleOrNamespaceRefsContentsToNameEnv g amap ad m root nenv modrefs = + (modrefs, nenv) ||> List.foldBack (fun modref acc -> AddModuleOrNamespaceRefContentsToNameEnv g amap ad m root acc modref) and AddTypeContentsToNameEnv g amap ad m nenv (typ: TType) = assert (isAppTy g typ) assert not (tcrefOfAppTy g typ).IsModuleOrNamespace AddContentOfTypeToNameEnv g amap ad m nenv typ -and AddEntityContentsToNameEnv g amap ad m root nenv (modref: EntityRef) = +and AddModuleOrNamespaceRefContentsToNameEnv g amap ad m root nenv (modref: EntityRef) = assert modref.IsModuleOrNamespace AddModuleOrNamespaceContentsToNameEnv g amap ad m root nenv modref diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index b66a125c5a0..1d19e8d4422 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -245,7 +245,7 @@ val internal AddModuleOrNamespaceRefsToNameEnv : TcGlobals -> val internal AddModuleOrNamespaceRefToNameEnv : TcGlobals -> ImportMap -> range -> bool -> AccessorDomain -> NameResolutionEnv -> ModuleOrNamespaceRef -> NameResolutionEnv /// Add a list of modules or namespaces to the name resolution environment -val internal AddEntitiesContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> ModuleOrNamespaceRef list -> NameResolutionEnv +val internal AddModuleOrNamespaceRefsContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> ModuleOrNamespaceRef list -> NameResolutionEnv /// Add the content of a type to the name resolution environment val internal AddTypeContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> NameResolutionEnv -> TType -> NameResolutionEnv diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 5e6b2191c97..ff264c24f5b 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -375,10 +375,10 @@ let AddLocalTyconsAndReport tcSink scopem g amap m tycons env = env /// Adjust the TcEnv to account for opening the set of modules or namespaces implied by an `open` declaration -let OpenEntities tcSink g amap scopem root env mvvs openDeclaration = +let OpenModuleOrNamespaceRefs tcSink g amap scopem root env mvvs openDeclaration = let env = if isNil mvvs then env else - { env with eNameResEnv = AddEntitiesContentsToNameEnv g amap env.eAccessRights scopem root env.eNameResEnv mvvs } + { env with eNameResEnv = AddModuleOrNamespaceRefsContentsToNameEnv g amap env.eAccessRights scopem root env.eNameResEnv mvvs } CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) CallOpenDeclarationSink tcSink openDeclaration env @@ -661,7 +661,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = let modrefs = List.map p23 modrefs let openTarget = SynOpenDeclTarget.ModuleOrNamespace(enclosingNamespacePathToOpen, scopem) let openDecl = OpenDeclaration.Create (openTarget, modrefs, [], scopem, true) - OpenEntities tcSink g amap scopem false env modrefs openDecl + OpenModuleOrNamespaceRefs tcSink g amap scopem false env modrefs openDecl | Exception _ -> env | _ -> env @@ -13013,7 +13013,7 @@ let TcOpenModuleOrNamespaceDecl tcSink g amap scopem env (longId, m) = modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult) let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.ModuleOrNamespace (longId, m), modrefs, [], scopem, false) - let env = OpenEntities tcSink g amap scopem false env modrefs openDecl + let env = OpenModuleOrNamespaceRefs tcSink g amap scopem false env modrefs openDecl env let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) = @@ -17937,7 +17937,7 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env | ValueSome _ -> let openTarget = SynOpenDeclTarget.ModuleOrNamespace([], scopem) let openDecl = OpenDeclaration.Create (openTarget, [modref], [], scopem, false) - OpenEntities TcResultsSink.NoSink g amap scopem root env [modref] openDecl + OpenModuleOrNamespaceRefs TcResultsSink.NoSink g amap scopem root env [modref] openDecl // Add the CCU and apply the "AutoOpen" attributes let AddCcuToTcEnv(g, amap, scopem, env, assemblyName, ccu, autoOpens, internalsVisible) = From 05fa1cc041d3196eba52aa8579a2f946be8e62dd Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 21 Jul 2020 16:48:30 -0700 Subject: [PATCH 59/89] minor cleanup --- src/fsharp/PrettyNaming.fs | 12 ++++-------- src/fsharp/TypeChecker.fs | 2 +- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index ea5ba7fdd42..2a6d0a64d89 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -512,20 +512,16 @@ let TryDemangleGenericNameAndPos (n: string) = else ValueNone -type NameArityPair = NameArityPair of string * int with +type NameArityPair = NameArityPair of string * int - member x.Arity = - match x with - | NameArityPair(_, arity) -> arity +let DemangleGenericTypeNameWithPos pos (mangledName: string) = + mangledName.Substring(0, pos) let DecodeGenericTypeNameWithPos pos (mangledName: string) = - let res = mangledName.Substring(0, pos) + let res = DemangleGenericTypeNameWithPos pos mangledName let num = mangledName.Substring(pos+1, mangledName.Length - pos - 1) NameArityPair(res, int32 num) -let DemangleGenericTypeNameWithPos pos (mangledName: string) = - mangledName.Substring(0, pos) - let DemangleGenericTypeName (mangledName: string) = match TryDemangleGenericNameAndPos mangledName with | ValueSome pos -> DemangleGenericTypeNameWithPos pos mangledName diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index ff264c24f5b..c2517b02516 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -9575,7 +9575,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, pathTypeArgs, afterR match delayed with | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: (DelayedDotLookup (longId, mLongId)) :: otherDelayed) -> // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs - // is a fresh instantiation for tcref. TcNestedTypeApplicatioen will chop off precisely #genericTyargs args + // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty pathTypeArgs tyargs From 2dd0fe3ff3b9896a8e7de31adb9b80cfc381d5d4 Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 21 Jul 2020 19:03:45 -0700 Subject: [PATCH 60/89] Minor rename --- src/fsharp/NameResolution.fs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 88cf168e96a..630ef89e38f 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2392,7 +2392,8 @@ let GetRecordLabelsForType g nenv ty = result.Add k |> ignore result -let ResolveNestedTypes (ncenv: NameResolver) (resInfo: ResolutionInfo) ad nm (typeNameResInfo: TypeNameResolutionInfo) m ty = +/// Get the nested types of the given type and check the nested types based on the type name resolution info. +let CheckForNestedTypesOfType (ncenv: NameResolver) (resInfo: ResolutionInfo) ad nm (typeNameResInfo: TypeNameResolutionInfo) m ty = let tinstEnclosing, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty let tcrefsNested = tcrefsNested |> List.map (fun tcrefNested -> (resInfo, tcrefNested)) let tcrefsNested = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefsNested, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) @@ -2473,7 +2474,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf let nestedSearchAccessible = match rest with | [] -> - let nestedTypes = ResolveNestedTypes ncenv resInfo ad nm typeNameResInfo m ty + let nestedTypes = CheckForNestedTypesOfType ncenv resInfo ad nm typeNameResInfo m ty if isNil nestedTypes then NoResultsOrUsefulErrors else @@ -2485,7 +2486,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | ResolveTypeNamesToTypeRefs -> OneSuccess (resInfo, Item.Types (nm, nestedTypes), rest) | id2 :: rest2 -> - let nestedTypes = ResolveNestedTypes ncenv resInfo ad nm (TypeNameResolutionInfo.ResolveToTypeRefs TypeNameResolutionStaticArgsInfo.Indefinite) m ty + let nestedTypes = CheckForNestedTypesOfType ncenv resInfo ad nm (TypeNameResolutionInfo.ResolveToTypeRefs TypeNameResolutionStaticArgsInfo.Indefinite) m ty ResolveLongIdentInNestedTypes ncenv nenv lookupKind resInfo (depth+1) id m ad id2 rest2 findFlag typeNameResInfo nestedTypes match nestedSearchAccessible with From 35fca6c3afbd2985e47a9b19c8ceb5e7d4f16bef Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 21 Jul 2020 19:04:40 -0700 Subject: [PATCH 61/89] Another rename --- src/fsharp/NameResolution.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 630ef89e38f..775e1094789 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2393,7 +2393,7 @@ let GetRecordLabelsForType g nenv ty = result /// Get the nested types of the given type and check the nested types based on the type name resolution info. -let CheckForNestedTypesOfType (ncenv: NameResolver) (resInfo: ResolutionInfo) ad nm (typeNameResInfo: TypeNameResolutionInfo) m ty = +let CheckNestedTypesOfType (ncenv: NameResolver) (resInfo: ResolutionInfo) ad nm (typeNameResInfo: TypeNameResolutionInfo) m ty = let tinstEnclosing, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty let tcrefsNested = tcrefsNested |> List.map (fun tcrefNested -> (resInfo, tcrefNested)) let tcrefsNested = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefsNested, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) @@ -2474,7 +2474,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf let nestedSearchAccessible = match rest with | [] -> - let nestedTypes = CheckForNestedTypesOfType ncenv resInfo ad nm typeNameResInfo m ty + let nestedTypes = CheckNestedTypesOfType ncenv resInfo ad nm typeNameResInfo m ty if isNil nestedTypes then NoResultsOrUsefulErrors else @@ -2486,7 +2486,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | ResolveTypeNamesToTypeRefs -> OneSuccess (resInfo, Item.Types (nm, nestedTypes), rest) | id2 :: rest2 -> - let nestedTypes = CheckForNestedTypesOfType ncenv resInfo ad nm (TypeNameResolutionInfo.ResolveToTypeRefs TypeNameResolutionStaticArgsInfo.Indefinite) m ty + let nestedTypes = CheckNestedTypesOfType ncenv resInfo ad nm (TypeNameResolutionInfo.ResolveToTypeRefs TypeNameResolutionStaticArgsInfo.Indefinite) m ty ResolveLongIdentInNestedTypes ncenv nenv lookupKind resInfo (depth+1) id m ad id2 rest2 findFlag typeNameResInfo nestedTypes match nestedSearchAccessible with From ddbce1461b296c88c80992822ecd825a1e3a197e Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 23 Jul 2020 09:56:16 -0700 Subject: [PATCH 62/89] Update src/fsharp/symbols/Symbols.fs Co-authored-by: Phillip Carter --- src/fsharp/symbols/Symbols.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 12dafff6f18..4fe8986ec97 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -2501,7 +2501,7 @@ and FSharpAssembly internal (cenv, ccu: CcuThunk) = [] type FSharpOpenDeclaration(target: SynOpenDeclTarget, range: range option, modules: FSharpEntity list, types: FSharpType list, appliedScope: range, isOwnNamespace: bool) = - member __.Target= target + member __.Target = target member __.LongId = match target with From 9b90d4bc368e8119e7df2a39ed12e1f70612a865 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 23 Jul 2020 12:08:46 -0700 Subject: [PATCH 63/89] Trying to add type provider test --- src/fsharp/TcGlobals.fs | 5 +++++ .../Language/OpenTypeDeclarationTests.fs | 18 ++++++++++++++++++ 2 files changed, 23 insertions(+) diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index b574214ecec..fe2502c6853 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1601,6 +1601,11 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d Some (g.array_set_info, [ety], argExprs) | "get_Item", [sty; _; _], _, [_; _] when isStringTy g sty -> Some (g.getstring_info, [], argExprs) + | "op_UnaryPlus", [aty], _, [_] -> + // Call Operators.(~+) + let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "op_UnaryPlus", None, None, [vara], ([[varaTy]], varaTy)) + let tyargs = [aty] + Some (info, tyargs, argExprs) | _ -> None diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 89235d7d1aa..f7417dc12bf 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -1616,3 +1616,21 @@ let main _ = |]) #endif + + [] + let ``Open contents of type provider`` () = + let typeProviderDir = FSharp.Tests.Core.getTestsDirectory "typeProviders\helloWorld" + + let providerFsx = + sprintf """ +module FSharpTest + +#load @"%s" + +//type Doot = FSharp.HelloWorld.HelloWorldType + """ (typeProviderDir ++ "provider.fsx") + + let providerCmpl = + Compilation.Create(providerFsx, Fsx, Library, options = [|"--langversion:preview"|]) + + CompilerAssert.Compile(providerCmpl) From 439046ecf578fd4496b68d0bd7e08ec11df2a95d Mon Sep 17 00:00:00 2001 From: TIHan Date: Fri, 24 Jul 2020 12:12:25 -0700 Subject: [PATCH 64/89] Remove type provider test for now --- src/fsharp/TcGlobals.fs | 5 ---- .../Language/OpenTypeDeclarationTests.fs | 23 ------------------- 2 files changed, 28 deletions(-) diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index fe2502c6853..b574214ecec 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1601,11 +1601,6 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d Some (g.array_set_info, [ety], argExprs) | "get_Item", [sty; _; _], _, [_; _] when isStringTy g sty -> Some (g.getstring_info, [], argExprs) - | "op_UnaryPlus", [aty], _, [_] -> - // Call Operators.(~+) - let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "op_UnaryPlus", None, None, [vara], ([[varaTy]], varaTy)) - let tyargs = [aty] - Some (info, tyargs, argExprs) | _ -> None diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index f7417dc12bf..f864015de7c 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -7,11 +7,6 @@ open NUnit.Framework open FSharp.Test.Utilities open FSharp.Test.Utilities.Utilities -(* - Tests in this file evaluate whether the language supports accessing functions on static classes using open - The feature was added in preview, the test cases ensure that the original errors are reproduced when the langversion:4.6 is specified -*) - [] module OpenTypeDeclarationTests = @@ -1616,21 +1611,3 @@ let main _ = |]) #endif - - [] - let ``Open contents of type provider`` () = - let typeProviderDir = FSharp.Tests.Core.getTestsDirectory "typeProviders\helloWorld" - - let providerFsx = - sprintf """ -module FSharpTest - -#load @"%s" - -//type Doot = FSharp.HelloWorld.HelloWorldType - """ (typeProviderDir ++ "provider.fsx") - - let providerCmpl = - Compilation.Create(providerFsx, Fsx, Library, options = [|"--langversion:preview"|]) - - CompilerAssert.Compile(providerCmpl) From 8676130846381330379400d8c175098bf45b43cc Mon Sep 17 00:00:00 2001 From: TIHan Date: Fri, 24 Jul 2020 15:05:07 -0700 Subject: [PATCH 65/89] Starting to convert tests --- .../Language/OpenTypeDeclarationTests.fs | 37 ++++++++++--------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index f864015de7c..1c77d94340e 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -6,6 +6,7 @@ open FSharp.Compiler.SourceCodeServices open NUnit.Framework open FSharp.Test.Utilities open FSharp.Test.Utilities.Utilities +open FSharp.Test.Utilities.Compiler [] module OpenTypeDeclarationTests = @@ -35,17 +36,20 @@ type NotAllowedToOpen() = [] let ``OpenSystemMathOnce - langversion:v4_6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ + Fsx (baseModule + """ module OpenSystemMathOnce = open type System.Math - let x = Min(1.0, 2.0)""") - [| - (FSharpErrorSeverity.Error, 3350, (22, 16, 22, 37), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") - (FSharpErrorSeverity.Error, 39, (23,24,23,27), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") - |] + let x = Min(1.0, 2.0) + """) + |> withOptions ["--langversion:4.6"] + |> typecheck + |> withDiagnostics + [ + (Error 3350, Line 22, Col 16, Line 22, Col 37, "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (Error 39, Line 23, Col 24, Line 23, Col 27, "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") + ] + |> ignore [] let ``OpenSystemMathOnce - langversion:preview`` () = @@ -802,19 +806,18 @@ let main _ = [] let ``Opened types do no allow unqualified access to their inherited type's members - Error`` () = - let fsharpSource = - """ + Fsx """ open type System.Math let x = Equals(2.0, 3.0) """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fsx, Exe, options = [|"--langversion:preview"|]) - - CompilerAssert.CompileWithErrors(fsCmpl, [| - (FSharpErrorSeverity.Error, 39, (4, 9, 4, 15), "The value or constructor 'Equals' is not defined.") - |]) + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + ( Error 39, Line 4, Col 9, Line 4, Col 15, "The value or constructor 'Equals' is not defined.") + ] + |> ignore [] let ``Opened types do no allow unqualified access to C#-style extension methods - Error`` () = From 30f57042a3e7ae59fb871f74fa00ddbe15371ec2 Mon Sep 17 00:00:00 2001 From: TIHan Date: Fri, 24 Jul 2020 15:28:45 -0700 Subject: [PATCH 66/89] More tests converted --- .../Language/OpenTypeDeclarationTests.fs | 129 ++++++++++-------- 1 file changed, 71 insertions(+), 58 deletions(-) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 1c77d94340e..75ce91baaf2 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -40,8 +40,7 @@ type NotAllowedToOpen() = module OpenSystemMathOnce = open type System.Math - let x = Min(1.0, 2.0) - """) + let x = Min(1.0, 2.0)""") |> withOptions ["--langversion:4.6"] |> typecheck |> withDiagnostics @@ -53,20 +52,19 @@ module OpenSystemMathOnce = [] let ``OpenSystemMathOnce - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ + Fsx (baseModule + """ module OpenSystemMathOnce = open type System.Math let x = Min(1.0, 2.0)""") - [| |] + |> withOptions ["--langversion:preview"] + |> typecheck + |> shouldSucceed + |> ignore [] let ``OpenSystemMathTwice - langversion:v4_6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ + Fsx (baseModule + """ module OpenSystemMathTwice = open type System.Math @@ -74,117 +72,132 @@ module OpenSystemMathTwice = open type System.Math let x2 = Min(2.0, 1.0)""") - [| - (FSharpErrorSeverity.Error, 3350, (22, 5, 22, 26), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") - (FSharpErrorSeverity.Error, 39, (23,13,23,16), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") - (FSharpErrorSeverity.Error, 3350, (25, 5, 25, 26), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") - (FSharpErrorSeverity.Error, 39, (26,14,26,17), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") - |] + |> withOptions ["--langversion:4.6"] + |> typecheck + |> withDiagnostics + [ + (Error 3350, Line 22, Col 5, Line 22, Col 26, "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (Error 39, Line 23, Col 13, Line 23, Col 16, "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") + (Error 3350, Line 25, Col 5, Line 25, Col 26, "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (Error 39, Line 26, Col 14, Line 26, Col 17, "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") + ] + |> ignore [] let ``OpenSystemMathTwice - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ + Fsx (baseModule + """ module OpenSystemMathOnce = open type System.Math let x = Min(1.0, 2.0)""") - [| |] + |> withOptions ["--langversion:preview"] + |> typecheck + |> shouldSucceed + |> ignore [] let ``OpenMyMathOnce - langversion:v4_6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ + Fsx (baseModule + """ module OpenMyMathOnce = open type MyMath let x = Min(1.0, 2.0) let x2 = Min(1, 2)""") - [| - (FSharpErrorSeverity.Error, 3350, (22, 5, 22, 21), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") - (FSharpErrorSeverity.Error, 39, (23,13,23,16), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") - (FSharpErrorSeverity.Error, 39, (24,14,24,17), "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") - |] + |> withOptions ["--langversion:4.6"] + |> typecheck + |> withDiagnostics + [ + (Error 3350, Line 22, Col 5, Line 22, Col 21, "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (Error 39, Line 23, Col 13, Line 23, Col 16, "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") + (Error 39, Line 24, Col 14, Line 24, Col 17, "The value or constructor 'Min' is not defined. Maybe you want one of the following:\r\n min\r\n sin") + ] + |> ignore [] let ``OpenMyMathOnce - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ + Fsx (baseModule + """ module OpenMyMathOnce = open type MyMath let x = Min(1.0, 2.0) let x2 = Min(1, 2)""") - [| |] + |> withOptions ["--langversion:preview"] + |> typecheck + |> shouldSucceed + |> ignore [] let ``DontOpenAutoMath - langversion:v4_6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ + Fsx (baseModule + """ module DontOpenAutoMath = let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") - [| - (FSharpErrorSeverity.Error, 39, (22,13,22,20), "The value or constructor 'AutoMin' is not defined.") - (FSharpErrorSeverity.Error, 39, (23,14,23,21), "The value or constructor 'AutoMin' is not defined.") - |] + |> withOptions ["--langversion:4.6"] + |> typecheck + |> withDiagnostics + [ + (Error 39, Line 22, Col 13, Line 22, Col 20, "The value or constructor 'AutoMin' is not defined.") + (Error 39, Line 23, Col 14, Line 23, Col 21, "The value or constructor 'AutoMin' is not defined.") + ] + |> ignore [] let ``DontOpenAutoMath - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ + Fsx (baseModule + """ module DontOpenAutoMath = let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") - [| |] + |> withOptions ["--langversion:preview"] + |> typecheck + |> shouldSucceed + |> ignore [] let ``OpenAutoMath - langversion:v4_6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ + Fsx (baseModule + """ module OpenAutoMath = open type AutoOpenMyMath //open type NotAllowedToOpen let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") - [| - (FSharpErrorSeverity.Error, 3350, (21, 5, 21, 29), "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") - (FSharpErrorSeverity.Error, 39, (24,13,24,20), "The value or constructor 'AutoMin' is not defined.") - (FSharpErrorSeverity.Error, 39, (25,14,25,21), "The value or constructor 'AutoMin' is not defined.") - |] + |> withOptions ["--langversion:4.6"] + |> typecheck + |> withDiagnostics + [ + (Error 3350, Line 21, Col 5, Line 21, Col 29, "Feature 'open type declaration' is not available in F# 4.6. Please use language version " + targetVersion + " or greater.") + (Error 39, Line 24, Col 13, Line 24, Col 20, "The value or constructor 'AutoMin' is not defined.") + (Error 39, Line 25, Col 14, Line 25, Col 21, "The value or constructor 'AutoMin' is not defined.") + ] + |> ignore [] let ``OpenAutoMath - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ + Fsx (baseModule + """ module OpenAutoMath = open type AutoOpenMyMath //open type NotAllowedToOpen let x = AutoMin(1.0, 2.0) let x2 = AutoMin(1, 2)""") - [| |] + |> withOptions ["--langversion:preview"] + |> typecheck + |> shouldSucceed + |> ignore [] let ``OpenAccessibleFields - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ + Fsx (baseModule + """ module OpenAFieldFromMath = open type System.Math let pi = PI""") - [||] + |> withOptions ["--langversion:preview"] + |> typecheck + |> shouldSucceed + |> ignore [] let ``Open type and use nested types as unqualified`` () = From 32700ba19681d8380390cfa4ea80efb3e2afb180 Mon Sep 17 00:00:00 2001 From: TIHan Date: Fri, 24 Jul 2020 16:03:37 -0700 Subject: [PATCH 67/89] More tests converted --- tests/FSharp.Test.Utilities/CompilerAssert.fs | 2 +- .../Language/OpenTypeDeclarationTests.fs | 272 +++++++----------- 2 files changed, 109 insertions(+), 165 deletions(-) diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 4956b3e2035..aae96b4d583 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -285,7 +285,7 @@ let main argv = 0""" | TestCompilationReference (cmpl) -> let filename = match cmpl with - | TestCompilation.CSharp c -> c.AssemblyName + | TestCompilation.CSharp c when not (String.IsNullOrWhiteSpace c.AssemblyName) -> c.AssemblyName | _ -> Path.GetRandomFileName() let tmp = Path.Combine(outputPath, Path.ChangeExtension(filename, ".dll")) disposals.Add({ new IDisposable with diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 75ce91baaf2..a52e914165b 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -201,8 +201,8 @@ module OpenAFieldFromMath = [] let ``Open type and use nested types as unqualified`` () = - let csharpSource = - """ + let csharp = + CSharp """ using System; namespace CSharpTest @@ -223,11 +223,9 @@ namespace CSharpTest } } } -} - """ +}""" - let fsharpSource = - """ + FSharp """ namespace FSharpTest open type CSharpTest.Test @@ -236,22 +234,17 @@ module Test = let x = NestedTest() let y = NestedTest() let a = x.A() - let b = y.B() - """ - - let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) - |> CompilationReference.Create - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - - CompilerAssert.Compile(fsCmpl) + let b = y.B()""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore [] let ``Open a type where the type declaration uses a type abbreviation as a qualifier to a real nested type`` () = - let csharpSource = - """ + let csharp = + CSharp """ using System; namespace CSharpTest @@ -272,31 +265,24 @@ namespace CSharpTest } } } -} - """ +}""" - let fsharpSource = - """ + FSharp """ namespace FSharpTest open System type Abbrev = CSharpTest.Test -open type Abbrev.NestedTest - """ - - let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) - |> CompilationReference.Create - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - - CompilerAssert.Compile(fsCmpl) +open type Abbrev.NestedTest""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore [] let ``Open a type where the type declaration uses a type abbreviation`` () = - let csharpSource = - """ + let csharp = + CSharp """ using System; namespace CSharpTest @@ -317,31 +303,24 @@ namespace CSharpTest } } } -} - """ +}""" - let fsharpSource = - """ + FSharp """ namespace FSharpTest open System type Abbrev = CSharpTest.Test -open type Abbrev - """ - - let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) - |> CompilationReference.Create - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - - CompilerAssert.Compile(fsCmpl) +open type Abbrev""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore [] let ``Open a nested type as qualified`` () = - let csharpSource = - """ + let csharp = + CSharp """ using System; namespace CSharpTest @@ -355,33 +334,26 @@ namespace CSharpTest } } } -} - """ +}""" - let fsharpSource = - """ + FSharp """ namespace FSharpTest open System open type CSharpTest.Test.NestedTest module Test = - let x = A() - """ - - let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) - |> CompilationReference.Create - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - - CompilerAssert.Compile(fsCmpl) + let x = A()""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore [] let ``Open generic type and use nested types as unqualified`` () = - let csharpSource = - """ + let csharp = + CSharp """ namespace CSharpTest { public class Test @@ -406,11 +378,9 @@ namespace CSharpTest public class Test { } -} - """ +}""" - let fsharpSource = - """ + FSharp """ namespace FSharpTest open System @@ -444,39 +414,31 @@ module Test2 = let x2b : byte = x2.B() let y2 : NestedTest = new NestedTest() - let y2a : byte = y2.A() - """ - - let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) - |> CompilationReference.Create - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - - CompilerAssert.Compile(fsCmpl) + let y2a : byte = y2.A()""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore [] let ``Open generic type and use nested types as unqualified 2`` () = - let fsharpSource = - """ + FSharp """ namespace FSharpTest open type System.Collections.Generic.List module Test = - let e2 = new Enumerator() - """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|]) - - CompilerAssert.Compile(fsCmpl) + let e2 = new Enumerator()""" + |> withOptions ["--langversion:preview"] + |> compile + |> shouldSucceed + |> ignore [] let ``Open generic type and use nested types as unqualified 3`` () = - let csharpSource = - """ + let csharp = + CSharp """ namespace CSharpTest { public class Test @@ -519,11 +481,9 @@ namespace CSharpTest } } } -} - """ +}""" - let fsharpSource = - """ + FSharp """ namespace FSharpTest open System @@ -573,22 +533,17 @@ module Test4 = let cc : float = c.C() let d : NestedNestedTest = NestedNestedTest() - let dd : int = d.D() - """ - - let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) - |> CompilationReference.Create - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - - CompilerAssert.Compile(fsCmpl) + let dd : int = d.D()""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore [] let ``Using the 'open' declaration on a possible type identifier - Error`` () = - let csharpSource = - """ + let csharp = + CSharp """ using System; namespace CSharpTest @@ -602,80 +557,69 @@ namespace CSharpTest } """ - let fsharpSource = - """ + FSharp """ namespace FSharpTest open System open CSharpTest.Test module Test = - let x = A() - """ - - let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) - |> CompilationReference.Create - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [csCmpl]) - - CompilerAssert.CompileWithErrors(fsCmpl, [| - (FSharpErrorSeverity.Error, 39, (5, 17, 5, 21), "The namespace 'Test' is not defined.") - (FSharpErrorSeverity.Error, 39, (8, 13, 8, 14), "The value or constructor 'A' is not defined.") - |]) + let x = A()""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> withDiagnostics + [ + (Error 39, Line 5, Col 17, Line 5, Col 21, "The namespace 'Test' is not defined.") + (Error 39, Line 8, Col 13, Line 8, Col 14, "The value or constructor 'A' is not defined.") + ] + |> ignore [] let ``Open type declaration on a namespace - Error`` () = - let fsharpSource = - """ + FSharp """ namespace FSharpTest -open type System - """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|]) - - CompilerAssert.CompileWithErrors(fsCmpl, [| - (FSharpErrorSeverity.Error, 39, (4, 11, 4, 17), "The type 'System' is not defined.") - |]) +open type System""" + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 39, Line 4, Col 11, Line 4, Col 17, "The type 'System' is not defined.") + ] + |> ignore [] let ``Open type declaration on a module - Error`` () = - let fsharpSource = - """ + FSharp """ namespace FSharpTest -open type FSharp.Core.Option - """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|]) - - CompilerAssert.CompileWithErrors(fsCmpl, [| - (FSharpErrorSeverity.Error, 33, (4, 11, 4, 29), "The type 'Microsoft.FSharp.Core.Option<_>' expects 1 type argument(s) but is given 0") - |]) +open type FSharp.Core.Option""" + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 33, Line 4, Col 11, Line 4, Col 29, "The type 'Microsoft.FSharp.Core.Option<_>' expects 1 type argument(s) but is given 0") + ] + |> ignore [] let ``Open type declaration on a byref - Error`` () = - let fsharpSource = - """ + FSharp """ namespace FSharpTest open type byref open type inref -open type outref - """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|]) - - CompilerAssert.CompileWithErrors(fsCmpl, [| - (FSharpErrorSeverity.Error, 3252, (4, 11, 4, 21), "Byref types are not allowed in an open type declaration.") - (FSharpErrorSeverity.Error, 3252, (5, 11, 5, 21), "Byref types are not allowed in an open type declaration.") - (FSharpErrorSeverity.Error, 3252, (6, 11, 6, 22), "Byref types are not allowed in an open type declaration.") - |]) +open type outref""" + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 3252, Line 4, Col 11, Line 4, Col 21, "Byref types are not allowed in an open type declaration.") + (Error 3252, Line 5, Col 11, Line 5, Col 21, "Byref types are not allowed in an open type declaration.") + (Error 3252, Line 6, Col 11, Line 6, Col 22, "Byref types are not allowed in an open type declaration.") + ] + |> ignore [] let ``Type extensions with static members are able to be accessed in an unqualified manner`` () = From 58821c0c21e67d36dd1f81dfae8da11a6ce815d9 Mon Sep 17 00:00:00 2001 From: TIHan Date: Fri, 24 Jul 2020 16:12:38 -0700 Subject: [PATCH 68/89] more tests converted --- .../Language/OpenTypeDeclarationTests.fs | 71 +++++++++---------- 1 file changed, 32 insertions(+), 39 deletions(-) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index a52e914165b..7b90ab672af 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -778,8 +778,7 @@ let x = Equals(2.0, 3.0) [] let ``Opened types do no allow unqualified access to C#-style extension methods - Error`` () = - let fsharpSource = - """ + FSharp """ open System.Runtime.CompilerServices module TestExtensions = @@ -794,23 +793,22 @@ open type TestExtensions.IntExtensions [] let main _ = Test(1) - 0 - """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) - - CompilerAssert.CompileWithErrors(fsCmpl, [| - (FSharpErrorSeverity.Error, 39, (15, 5, 15, 9), - "The value or constructor 'Test' is not defined. Maybe you want one of the following: + 0""" + |> withOptions ["--langversion:preview"] + |> asExe + |> compile + |> withDiagnostics + [ + (Error 39, Line 15, Col 5, Line 15, Col 9, + "The value or constructor 'Test' is not defined. Maybe you want one of the following: Text TestExtensions") - |]) + ] + |> ignore [] let ``Opened types do allow unqualified access to C#-style extension methods if type has no [] attribute`` () = - let fsharpSource = - """ + FSharp """ open System.Runtime.CompilerServices module TestExtensions = @@ -824,18 +822,16 @@ open type TestExtensions.IntExtensions [] let main _ = Test(1) - 0 - """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) - - CompilerAssert.Compile(fsCmpl) + 0""" + |> withOptions ["--langversion:preview"] + |> asExe + |> compile + |> shouldSucceed + |> ignore [] let ``Opened types do allow unqualified access to members with no [] attribute`` () = - let fsharpSource = - """ + FSharp """ open System.Runtime.CompilerServices module TestExtensions = @@ -849,18 +845,16 @@ open type TestExtensions.IntExtensions [] let main _ = Test(1) - 0 - """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) - - CompilerAssert.Compile(fsCmpl) + 0""" + |> withOptions ["--langversion:preview"] + |> asExe + |> compile + |> shouldSucceed + |> ignore [] let ``Opened types with C# style extension members are available for normal extension method lookup`` () = - let fsharpSource = - """ + FSharp """ open System.Runtime.CompilerServices module TestExtensions = @@ -876,13 +870,12 @@ open type TestExtensions.IntExtensions let main _ = let x = 1 x.Test() - 0 - """ - - let fsCmpl = - Compilation.Create(fsharpSource, Fs, Exe, options = [|"--langversion:preview"|]) - - CompilerAssert.Compile(fsCmpl) + 0""" + |> withOptions ["--langversion:preview"] + |> asExe + |> compile + |> shouldSucceed + |> ignore [] let ``An assembly with an event and field with the same name, favor the field`` () = From 3d42c6d14f14ed5e090137508b8f07cb9d368fab Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 27 Jul 2020 17:28:50 -0700 Subject: [PATCH 69/89] Added type provider tests --- tests/FSharp.Test.Utilities/Compiler.fs | 2 +- tests/FSharp.Test.Utilities/CompilerAssert.fs | 8 +- .../Language/OpenTypeDeclarationTests.fs | 202 ++++++++++++++++++ 3 files changed, 207 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 6c6c51b10da..4a9ccaecf6c 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -222,7 +222,7 @@ module rec Compiler = let private compileFSharpCompilation compilation ignoreWarnings : CompilationResult = - let ((err: FSharpErrorInfo[], outputFilePath: string), _) = CompilerAssert.CompileRaw(compilation) + let ((err: FSharpErrorInfo[], outputFilePath: string), _) = CompilerAssert.CompileRaw(compilation, ignoreWarnings) let (errors, warnings) = err |> fromFSharpErrorInfo diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index aae96b4d583..11715633188 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -365,10 +365,10 @@ let main argv = 0""" // NOTE: This function will not clean up all the compiled projects after itself. // The reason behind is so we can compose verification of test runs easier. // TODO: We must not rely on the filesystem when compiling - static let rec returnCompilation (cmpl: Compilation) = + static let rec returnCompilation (cmpl: Compilation) ignoreWarnings = let compileDirectory = Path.Combine(Path.GetTempPath(), "CompilerAssert", Path.GetRandomFileName()) Directory.CreateDirectory(compileDirectory) |> ignore - compileCompilationAux compileDirectory (ResizeArray()) false cmpl + compileCompilationAux compileDirectory (ResizeArray()) ignoreWarnings cmpl static member CompileWithErrors(cmpl: Compilation, expectedErrors, ?ignoreWarnings) = let ignoreWarnings = defaultArg ignoreWarnings false @@ -379,8 +379,8 @@ let main argv = 0""" static member Compile(cmpl: Compilation, ?ignoreWarnings) = CompilerAssert.CompileWithErrors(cmpl, [||], defaultArg ignoreWarnings false) - static member CompileRaw(cmpl: Compilation) = - lock gate (fun () -> returnCompilation cmpl) + static member CompileRaw(cmpl: Compilation, ?ignoreWarnings) = + lock gate (fun () -> returnCompilation cmpl (defaultArg ignoreWarnings false)) static member Execute(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute, ?newProcess, ?onOutput) = let ignoreWarnings = defaultArg ignoreWarnings false diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 7b90ab672af..9adbc6f62f5 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -7,6 +7,7 @@ open NUnit.Framework open FSharp.Test.Utilities open FSharp.Test.Utilities.Utilities open FSharp.Test.Utilities.Compiler +open FSharp.Tests [] module OpenTypeDeclarationTests = @@ -1564,3 +1565,204 @@ let main _ = |]) #endif + +#if !NETCOREAPP + + [] + let ``Opening type providers with abbreviation result in unqualified access to types and members`` () = + let dir = Core.getTestsDirectory "typeProviders/helloWorld" + + let provider = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provider.fsx")) + |> withName "provider" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let provided = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provided.fs")) + |> withName "provided" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let test = + Fsx """ +type T = FSharp.HelloWorld.HelloWorldTypeWithStaticInt32Parameter<1> + +open type T + +if NestedType.StaticProperty1 <> "You got a static property" then + failwith "failed" + +open type T.NestedType + +if StaticProperty1 <> "You got a static property" then + failwith "failed" + """ + |> asExe + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + |> withReferences [provider;provided] + + compileAndRun test + |> ignore + + [] + let ``Opening type providers result in unqualified access to types and members`` () = + let dir = Core.getTestsDirectory "typeProviders/helloWorld" + + let provider = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provider.fsx")) + |> withName "provider" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let provided = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provided.fs")) + |> withName "provided" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let test = + Fsx """ +open type FSharp.HelloWorld.HelloWorldTypeWithStaticInt32Parameter<1> + +if NestedType.StaticProperty1 <> "You got a static property" then + failwith "failed" + +open type NestedType + +if StaticProperty1 <> "You got a static property" then + failwith "failed" + """ + |> asExe + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + |> withReferences [provider;provided] + + compileAndRun test + |> ignore + + [] + let ``Opening type providers with nested result in unqualified access to types and members`` () = + let dir = Core.getTestsDirectory "typeProviders/helloWorld" + + let provider = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provider.fsx")) + |> withName "provider" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let provided = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provided.fs")) + |> withName "provided" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let test = + Fsx """ +open type FSharp.HelloWorld.HelloWorldTypeWithStaticInt32Parameter<1>.NestedType + +if StaticProperty1 <> "You got a static property" then + failwith "failed" + """ + |> asExe + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + |> withReferences [provider;provided] + + compileAndRun test + |> ignore + + [] + let ``Opening generative type providers in unqualified access to types and members`` () = + let dir = Core.getTestsDirectory "typeProviders/helloWorld" + + let provider = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provider.fsx")) + |> withName "provider" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let provided = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provided.fs")) + |> withName "provided" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let test = + Fsx """ +type TheOuterType = FSharp.HelloWorldGenerative.TheContainerType<"TheOuterType"> + +open type TheOuterType + +let _ : TheNestedGeneratedType = Unchecked.defaultof<_> + """ + |> asExe + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + |> withReferences [provider;provided] + + compileAndRun test + |> ignore + + [] + let ``Opening generative type providers directly in unqualified access to types and members - Errors`` () = + let dir = Core.getTestsDirectory "typeProviders/helloWorld" + + let provider = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provider.fsx")) + |> withName "provider" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let provided = + Fsx (sprintf """ +#load @"%s" + """ (dir ++ "provided.fs")) + |> withName "provided" + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + + let test = + Fsx """ +open type FSharp.HelloWorldGenerative.TheContainerType<"TheOuterType"> + +let _ : TheNestedGeneratedType = Unchecked.defaultof<_> + """ + |> asExe + |> ignoreWarnings + |> withOptions ["--langversion:preview"] + |> withReferences [provider;provided] + + compile test + |> withDiagnostics + [ + (Error 3039, Line 2, Col 11, Line 2, Col 55, "A direct reference to the generated type 'TheContainerType' is not permitted. Instead, use a type definition, e.g. 'type TypeAlias = '. This indicates that a type provider adds generated types to your assembly.") + (Error 39, Line 4, Col 9, Line 4, Col 31, "The type 'TheNestedGeneratedType' is not defined. Maybe you want one of the following: + TheGeneratedType1 + TheGeneratedType2 + TheGeneratedType4 + TheGeneratedType5 + TheGeneratedDelegateType") + ] + |> ignore + +#endif From 5bad5b2bdf47c2a17a8504058203e2b2d3f3dea2 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 28 Jul 2020 14:06:48 -0700 Subject: [PATCH 70/89] Added complex generic types with nested generic types --- .../Language/OpenTypeDeclarationTests.fs | 99 +++++++++++++++++++ 1 file changed, 99 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 9adbc6f62f5..b2b8c5143de 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -541,6 +541,105 @@ module Test4 = |> shouldSucceed |> ignore + [] + let ``Open generic type and use nested types as unqualified 4`` () = + let csharp = + CSharp """ +namespace CSharpTest +{ + public class Test + { + public class NestedTest + { + public class NestedNestedTest + { + public T7 A() + { + return default(T7); + } + } + + public class NestedNestedTest + { + public T8 B() + { + return default(T8); + } + } + + public class NestedNestedTest + { + public T9 C() + { + return default(T9); + } + } + } + } +}""" + + FSharp """ +namespace FSharpTest + +open System +open CSharpTest + +open type Test.NestedTest + +module Test = + + let aa : NestedNestedTest = NestedNestedTest() + + let bb : NestedNestedTest = NestedNestedTest() + + let cc : NestedNestedTest = NestedNestedTest() + + let r1 : string = aa.A() + + let r2 : int list = bb.B() + + let r3 : float list = cc.C() + +open type Test + +module Test2 = + + let a : NestedTest = NestedTest() + + let aa : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + + let bb : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + + let cc : NestedTest.NestedNestedTest = NestedTest.NestedNestedTest() + + let r1 : uint32 = aa.A() + + let r2 : int [] = bb.B() + + let r3 : float [] = cc.C() + +module Test3 = + + let a : Test.NestedTest = Test.NestedTest() + + let aa : Test.NestedTest.NestedNestedTest = Test.NestedTest.NestedNestedTest() + + let bb : Test.NestedTest.NestedNestedTest = Test.NestedTest.NestedNestedTest() + + let cc : Test.NestedTest.NestedNestedTest = Test.NestedTest.NestedNestedTest() + + let r1 : int64 = aa.A() + + let r2 : string = bb.B() + + let r3 : int list = cc.C() + """ + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore + [] let ``Using the 'open' declaration on a possible type identifier - Error`` () = let csharp = From 2babcd2987a03bd434c25ba5605c90ed71b4c128 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 28 Jul 2020 16:17:59 -0700 Subject: [PATCH 71/89] Added units of measure tests and named types --- .../Language/OpenTypeDeclarationTests.fs | 214 ++++++++++++++++++ 1 file changed, 214 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index b2b8c5143de..5fbb81705e9 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -640,6 +640,220 @@ module Test3 = |> shouldSucceed |> ignore + [] + let ``Open unit of measure - Errors`` () = + FSharp """ +namespace FSharpTest + +open System + +[] +type kg + +open type kg + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 704, Line 9, Col 11, Line 9, Col 13, "Expected type, not unit-of-measure") + ] + |> ignore + + [] + let ``Open type with unit of measure`` () = + FSharp """ +namespace FSharpTest + +open System +open System.Numerics + +[] +type kg + +open type float + +[] +type vec3<[] 'Measure> = Vector3 + +open type vec3 + """ + |> withOptions ["--langversion:preview"] + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Open custom type with unit of measure`` () = + FSharp """ +namespace FSharpTest + +[] +type kg + +type Custom<[] 'Measure> = + { + X: float<'Measure> + Y: float<'Measure> + } + + static member GetX(c: Custom<'Measure>) = c.X + + static member GetY(c: Custom<'Measure>) = c.Y + +open type Custom + +module Test = + + let x : float = GetX(Unchecked.defaultof<_>) + + let y : float = GetY(Unchecked.defaultof<_>) + + """ + |> withOptions ["--langversion:preview"] + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Open custom type with unit of measure and more type params`` () = + FSharp """ +namespace FSharpTest + +[] +type kg + +type Custom<'T, [] 'Measure, 'U> = + { + X: float<'Measure> + Y: float<'Measure> + Z: 'T + W: 'U + } + + static member GetX(c: Custom<'T, 'Measure, 'U>) = c.X + + static member GetY(c: Custom<'T, 'Measure, 'U>) = c.Y + + static member GetZ(c: Custom<'T, 'Measure, 'U>) = c.Z + + static member GetW(c: Custom<'T, 'Measure, 'U>) = c.W + +open type Custom + +module Test = + + let x : float = GetX(Unchecked.defaultof<_>) + + let y : float = GetY(Unchecked.defaultof<_>) + + let z : int = GetZ(Unchecked.defaultof<_>) + + let w : float = GetW(Unchecked.defaultof<_>) + """ + |> withOptions ["--langversion:preview"] + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Open custom type with unit of measure should error with measure mismatch`` () = + FSharp """ +namespace FSharpTest + +[] +type kg + +[] +type g + +type Custom<[] 'Measure> = + { + X: float<'Measure> + Y: float<'Measure> + } + + static member GetX(c: Custom<'Measure>) = c.X + + static member GetY(c: Custom<'Measure>) = c.Y + +open type Custom + +module Test = + + let x : float = GetX(Unchecked.defaultof<_>) + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withErrorCode 1 + |> ignore + + [] + let ``Open tuple - Errors`` () = + FSharp """ +namespace FSharpTest + +open type (int * int) + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 4, Col 11, Line 4, Col 22, "'open type' may only be used with named types") + ] + |> ignore + + [] + let ``Open function - Errors`` () = + FSharp """ +namespace FSharpTest + +open type (int -> int) + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 4, Col 11, Line 4, Col 23, "'open type' may only be used with named types") + ] + |> ignore + + [] + let ``Open direct tuple - Errors`` () = + // Note: `Tuple` is technically a named type but it gets decompiled into F#'s representation of a tuple in its type system. + // This test is to verify that behavior. + FSharp """ +namespace FSharpTest + +open System + +open type Tuple + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 6, Col 11, Line 6, Col 26, "'open type' may only be used with named types") + ] + |> ignore + + [] + let ``Open direct function - Errors`` () = + // Note: `FSharpFunc` is technically a named type but it gets decompiled into F#'s representation of a function in its type system. + // This test is to verify that behavior. + FSharp """ +namespace FSharpTest + +open type FSharpFunc + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 4, Col 11, Line 4, Col 31, "'open type' may only be used with named types") + ] + |> ignore + [] let ``Using the 'open' declaration on a possible type identifier - Error`` () = let csharp = From 4189e26449cc1c6721f30ef62ef22b801fb67221 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 28 Jul 2020 17:07:40 -0700 Subject: [PATCH 72/89] Added more tests --- .../Language/OpenTypeDeclarationTests.fs | 64 +++++++++++++++++++ 1 file changed, 64 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 5fbb81705e9..7fc4fb4dccc 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -803,6 +803,21 @@ open type (int * int) ] |> ignore + [] + let ``Open struct tuple - Errors`` () = + FSharp """ +namespace FSharpTest + +open type struct (int * int) + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 4, Col 11, Line 4, Col 29, "'open type' may only be used with named types") + ] + |> ignore + [] let ``Open function - Errors`` () = FSharp """ @@ -818,6 +833,36 @@ open type (int -> int) ] |> ignore + [] + let ``Open anon type - Errors`` () = + FSharp """ +namespace FSharpTest + +open type {| x: int |} + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 4, Col 11, Line 4, Col 23, "'open type' may only be used with named types") + ] + |> ignore + + [] + let ``Open struct anon type - Errors`` () = + FSharp """ +namespace FSharpTest + +open type struct {| x: int |} + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 4, Col 11, Line 4, Col 30, "'open type' may only be used with named types") + ] + |> ignore + [] let ``Open direct tuple - Errors`` () = // Note: `Tuple` is technically a named type but it gets decompiled into F#'s representation of a tuple in its type system. @@ -837,6 +882,25 @@ open type Tuple ] |> ignore + [] + let ``Open direct value tuple - Errors`` () = + // Note: `ValueTuple` is technically a named type but it gets decompiled into F#'s representation of a struct tuple in its type system. + // This test is to verify that behavior. + FSharp """ +namespace FSharpTest + +open System + +open type ValueTuple + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 6, Col 11, Line 6, Col 31, "'open type' may only be used with named types") + ] + |> ignore + [] let ``Open direct function - Errors`` () = // Note: `FSharpFunc` is technically a named type but it gets decompiled into F#'s representation of a function in its type system. From 3013fb7ed51363015ba5f3b63f3b0eab77da651e Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 28 Jul 2020 23:07:57 -0700 Subject: [PATCH 73/89] Added two more tests --- .../Language/OpenTypeDeclarationTests.fs | 53 +++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 7fc4fb4dccc..ff714ca7538 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -918,6 +918,59 @@ open type FSharpFunc ] |> ignore + [] + let ``Open union should have no access to union cases - Errors`` () = + FSharp """ +namespace FSharpTest + +module Test = + + type TestUnion = + | UCase1 + | UCase2 with + + static member M() = () + +open type Test.TestUnion + +module Test2 = + + let x = UCase1 + + let y = M() + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 39, Line 16, Col 13, Line 16, Col 19, "The value or constructor 'UCase1' is not defined.") + ] + |> ignore + + [] + let ``Open type should have no access to constructor - Errors`` () = + FSharp """ +namespace FSharpTest + +module Test = + + type TestClass() = + + static member M() = () + +open type Test.TestClass + +module Test2 = + + let x = TestClass() + + let y = M() + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withErrorCode 39 + |> ignore + [] let ``Using the 'open' declaration on a possible type identifier - Error`` () = let csharp = From ea3003f35a1f16264d5bfd3c97089667dda07184 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 29 Jul 2020 01:53:37 -0700 Subject: [PATCH 74/89] Added one more test --- .../Language/OpenTypeDeclarationTests.fs | 27 +++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index ff714ca7538..700aa4d4664 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -947,6 +947,33 @@ module Test2 = ] |> ignore + [] + let ``Open record should have no access to construct record - Errors`` () = + FSharp """ +namespace FSharpTest + +module Test = + + type TestRecord = { X: int } with + + static member M() = () + +open type Test.TestRecord + +module Test2 = + + let x = { X = 1 } + + let y = M() + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 39, Line 14, Col 15, Line 14, Col 16, "The record label 'X' is not defined.") + ] + |> ignore + [] let ``Open type should have no access to constructor - Errors`` () = FSharp """ From cc53b26aac3160c3fae285e566fbc0820177b4c0 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 29 Jul 2020 17:52:08 -0700 Subject: [PATCH 75/89] Added enum test case --- .../Language/OpenTypeDeclarationTests.fs | 23 +++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 700aa4d4664..6ddf68b77a2 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -918,6 +918,29 @@ open type FSharpFunc ] |> ignore + [] + let ``Open enum should have access to its cases`` () = + FSharp """ +namespace FSharpTest + +type TestEnum = + | EnumCase1 = 1 + | EnumCase2 = 2 + +open type TestEnum + +module Test = + + let x = EnumCase1 + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withDiagnostics + [ + (Error 756, Line 4, Col 11, Line 4, Col 31, "'open type' may only be used with named types") + ] + |> ignore + [] let ``Open union should have no access to union cases - Errors`` () = FSharp """ From a5c965738c64b5f1a633a9cc6f8899f9e2d86b58 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Wed, 29 Jul 2020 18:22:21 -0700 Subject: [PATCH 76/89] Added enum tests and support --- src/fsharp/NameResolution.fs | 14 ++++++- .../Language/OpenTypeDeclarationTests.fs | 42 +++++++++++++++---- 2 files changed, 46 insertions(+), 10 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 775e1094789..40855c06880 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1047,6 +1047,13 @@ let ChoosePropInfosForNameEnv g ty (pinfos: PropInfo list) = KeyValuePair(propName, Item.Property(propName, propGroup)) } +let ChooseFSharpFieldInfosForNameEnv g ty (rfinfos: RecdFieldInfo list) = + seq { + for rfinfo in rfinfos do + if rfinfo.IsStatic && typeEquiv g rfinfo.DeclaringType ty then + KeyValuePair(rfinfo.Name, Item.RecdField rfinfo) + } + let ChooseILFieldInfosForNameEnv g ty (finfos: ILFieldInfo list) = seq { for finfo in finfos do @@ -1096,7 +1103,12 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n infoReader.GetEventInfosOfType(None, ad, m, ty) |> ChooseEventInfosForNameEnv g ty - // Fields + // FSharp fields + yield! + infoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) + |> ChooseFSharpFieldInfosForNameEnv g ty + + // IL fields yield! infoReader.GetILFieldInfosOfType(None, ad, m, ty) |> ChooseILFieldInfosForNameEnv g ty diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 6ddf68b77a2..d2ca99552c1 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -932,17 +932,44 @@ open type TestEnum module Test = let x = EnumCase1 + let y = EnumCase2 """ |> withOptions ["--langversion:preview"] |> compile - |> withDiagnostics - [ - (Error 756, Line 4, Col 11, Line 4, Col 31, "'open type' may only be used with named types") - ] + |> shouldSucceed + |> ignore + + [] + let ``Open C# enum should have access to its cases`` () = + let csharp = + CSharp """ +namespace CSharpTest +{ + public enum CSharpEnum + { + CSharpEnumCase1 = 1, + CsharpEnumCase2 = 2 + } +} + """ + + FSharp """ +namespace FSharpTest + +open type CSharpTest.CSharpEnum + +module Test = + + let x = CSharpEnumCase1 + let y = CSharpEnumCase2 + """ + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile |> ignore [] - let ``Open union should have no access to union cases - Errors`` () = + let ``Open union should have access to union cases`` () = FSharp """ namespace FSharpTest @@ -964,10 +991,7 @@ module Test2 = """ |> withOptions ["--langversion:preview"] |> compile - |> withDiagnostics - [ - (Error 39, Line 16, Col 13, Line 16, Col 19, "The value or constructor 'UCase1' is not defined.") - ] + |> shouldSucceed |> ignore [] From aa288fe20c59f881476ba5d032691225dec48dba Mon Sep 17 00:00:00 2001 From: TIHan Date: Fri, 31 Jul 2020 09:44:06 -0700 Subject: [PATCH 77/89] Adding union case support --- src/fsharp/NameResolution.fs | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 40855c06880..ca89ae1f613 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1072,17 +1072,29 @@ let ChooseEventInfosForNameEnv g ty (einfos: EventInfo list) = /// Rules: /// 1. Add nested types. /// 2. Add C# style extension members. -/// 3. Add extention methods. -/// 4. Add extension properties. -/// 5. Add events. -/// 6. Add fields. -/// 7. Add properies. -/// 8. Add methods. +/// 3. Add union cases. +/// 4. Add extention methods. +/// 5. Add extension properties. +/// 6. Add events. +/// 7. Add fields. +/// 8. Add properies. +/// 9. Add methods. let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) let nenv = AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty let nenv = AddCSharpStyleExtensionMembersOfTypeToNameEnv amap m nenv ty + let nenv = + match tryTcrefOfAppTy g ty with + | ValueSome tcref when not tcref.IsILTycon -> + let ucrefs = tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef + let unqualifiedItems = AddUnionCases2 BulkAdd.Yes nenv.eUnqualifiedItems ucrefs + let patItems = AddUnionCases1 nenv.ePatItems ucrefs + { nenv with + eUnqualifiedItems = unqualifiedItems + ePatItems = patItems } + | _ -> + nenv // The order of items matter such as intrinsic members will always be favored over extension members of the same name. // Extension property members will always be favored over extenion methods of the same name. @@ -1230,8 +1242,8 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) let nenv = if amap.g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && not isIL && - TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true then - if tcref.Typars(m).Length > 0 then failwith "nope" // TODO proper error + TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && + tcref.Typars(m).Length = 0 then let ty = generalizedTyconRef tcref AddContentOfTypeToNameEnv g amap ad m nenv ty else From cf030efa9a9aac3691649a657164c509ce5c02b9 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 4 Aug 2020 17:21:19 -0700 Subject: [PATCH 78/89] Removing unions support --- src/fsharp/NameResolution.fs | 28 ++++++++-------------------- 1 file changed, 8 insertions(+), 20 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 64fc9cf9587..8196dac9615 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1072,29 +1072,17 @@ let ChooseEventInfosForNameEnv g ty (einfos: EventInfo list) = /// Rules: /// 1. Add nested types. /// 2. Add C# style extension members. -/// 3. Add union cases. -/// 4. Add extention methods. -/// 5. Add extension properties. -/// 6. Add events. -/// 7. Add fields. -/// 8. Add properies. -/// 9. Add methods. +/// 3. Add extention methods. +/// 4. Add extension properties. +/// 5. Add events. +/// 6. Add fields. +/// 7. Add properies. +/// 8. Add methods. let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) let nenv = AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty let nenv = AddCSharpStyleExtensionMembersOfTypeToNameEnv amap m nenv ty - let nenv = - match tryTcrefOfAppTy g ty with - | ValueSome tcref when not tcref.IsILTycon -> - let ucrefs = tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef - let unqualifiedItems = AddUnionCases2 BulkAdd.Yes nenv.eUnqualifiedItems ucrefs - let patItems = AddUnionCases1 nenv.ePatItems ucrefs - { nenv with - eUnqualifiedItems = unqualifiedItems - ePatItems = patItems } - | _ -> - nenv // The order of items matter such as intrinsic members will always be favored over extension members of the same name. // Extension property members will always be favored over extenion methods of the same name. @@ -2866,7 +2854,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | _ -> false if ValIsInEnv id.idText then - success (nenv.eUnqualifiedItems.[id.idText], rest) + success (nenv.eUnqualifiedItems.[id.idText], rest, resInfo.EnclosingTypeInst) else // 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. @@ -2939,7 +2927,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | Exception e -> raze e | Result (resInfo, item, rest) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - success (item, rest, restInfo.EnclosingTypeInst) + success (item, rest, resInfo.EnclosingTypeInst) let ResolveExprLongIdent sink (ncenv: NameResolver) m ad nenv typeNameResInfo lid = match lid with From 72bae82c078e4eee89f890ef21ca3f5f6fe6efde Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 4 Aug 2020 17:47:48 -0700 Subject: [PATCH 79/89] Fixing build --- src/fsharp/NameResolution.fs | 24 ++++++++++++------------ src/fsharp/NameResolution.fsi | 6 +----- src/fsharp/TypeChecker.fs | 22 +++++++++++----------- 3 files changed, 24 insertions(+), 28 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 8196dac9615..3c405737a25 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2760,9 +2760,9 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified let search = ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) match AtMostOneResult m search with - | Result (resInfo, item, rest) -> + | Result (resInfo, item) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - Some(item, rest, resInfo.EnclosingTypeInst) + Some(item, rest) | Exception e -> typeError <- Some e None @@ -2776,8 +2776,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // Do not resolve `nameof` if the feature is unsupported, even if it is FSharp.Core None else - Some (fresh, rest, []) - | _ -> Some (fresh, rest, []) + Some (fresh, rest) + | _ -> Some (fresh, rest) | _ -> None @@ -2834,9 +2834,9 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified failingCase match res with | Exception e -> raze e - | Result (resInfo, item, rest) -> + | Result (resInfo, item) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - success (item, rest, resInfo.EnclosingTypeInst) + success (item, rest) // A compound identifier. // It still might be a value in the environment, or something in an F# module, namespace, type, or nested type @@ -2854,12 +2854,12 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | _ -> false if ValIsInEnv id.idText then - success (nenv.eUnqualifiedItems.[id.idText], rest, resInfo.EnclosingTypeInst) + success (nenv.eUnqualifiedItems.[id.idText], rest) else // 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 () = - ResolveLongIndentAsModuleOrNamespaceThen 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 (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad) // REVIEW: somewhat surprisingly, this shows up on performance traces, with tcrefs non-nil. @@ -2887,7 +2887,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified match nenv.eUnqualifiedItems.TryGetValue id.idText with | true, Item.UnqualifiedType _ | false, _ -> NoResultsOrUsefulErrors - | true, res -> OneSuccess (resInfo, FreshenUnqualifiedItem ncenv m res, rest) + | true, res -> OneSuccess (ResolutionInfo.Empty, FreshenUnqualifiedItem ncenv m res, rest) moduleSearch ad () +++ tyconSearch ad +++ envSearch @@ -2927,7 +2927,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | Exception e -> raze e | Result (resInfo, item, rest) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - success (item, rest, resInfo.EnclosingTypeInst) + success (item, rest) let ResolveExprLongIdent sink (ncenv: NameResolver) m ad nenv typeNameResInfo lid = match lid with @@ -3598,7 +3598,7 @@ type AfterResolution = let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv typeNameResInfo lid = match ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid with | Exception e -> Exception e - | Result (item1, rest, tinstEnclosing) -> + | Result (item1, rest) -> let itemRange = ComputeItemRange wholem lid rest let item = FilterMethodGroups ncenv itemRange item1 true @@ -3646,7 +3646,7 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso callSink (item, emptyTyparInst) AfterResolution.DoNothing - success (item, itemRange, rest, tinstEnclosing, afterResolution) + success (item, itemRange, rest, afterResolution) let (|NonOverridable|_|) namedItem = match namedItem with diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index a87a71c720d..1ae4afc7457 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -557,7 +557,7 @@ val internal ResolveTypeLongIdentAndEnclosingTypeInst : TcResultsSink -> NameRes val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list /// Resolve a long identifier occurring in an expression position -val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException +val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException /// Resolve a (possibly incomplete) long identifier to a loist of possible class or record fields val internal ResolvePartialLongIdentToClassOrRecdFields : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> bool -> Item list @@ -583,11 +583,7 @@ type AfterResolution = | RecordResolution of Item option * (TyparInst -> unit) * (MethInfo * PropInfo option * TyparInst -> unit) * (unit -> unit) /// Resolve a long identifier occurring in an expression position. -<<<<<<< HEAD -val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * range * Ident list * TypeInst * AfterResolution -======= val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException ->>>>>>> upstream/master /// Resolve a long identifier occurring in an expression position, qualified by a type. val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> TypeNameResolutionInfo -> FindMemberFlag -> bool -> Item * range * Ident list * TypeInst * AfterResolution diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 0fefb0c63e8..23051fcd056 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3213,7 +3213,7 @@ let (|JoinRelation|_|) cenv env (e: SynExpr) = let isOpName opName vref s = (s = opName) && match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default [ident(opName, m)] with - | Result (Item.Value vref2, [], _) -> valRefEq cenv.g vref vref2 + | Result (Item.Value vref2, []) -> valRefEq cenv.g vref vref2 | _ -> false match e with @@ -9365,7 +9365,7 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = let resolvedToModuleOrNamespaceName = if delayed.IsEmpty then let id,rest = List.headAndTail longId - match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest true with + match ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest true 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 | _ -> @@ -9482,7 +9482,7 @@ and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) dela // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen cenv overallTy env tpenv (item, mItem, rest, pathTypeArgs, afterResolution) delayed = +and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) delayed = let g = cenv.g let delayed = delayRest rest mItem delayed let ad = env.eAccessRights @@ -9638,18 +9638,18 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, pathTypeArgs, afterR // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty pathTypeArgs tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty [] tyargs // Report information about the whole expression including type arguments to VS let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed let item, mItem, rest, _, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true - TcItemThen cenv overallTy env tpenv (item, mItem, rest, (argsOfAppTy g ty), afterResolution) otherDelayed + TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty pathTypeArgs tyargs + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty [] tyargs let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) @@ -9721,7 +9721,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, pathTypeArgs, afterR | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: (DelayedApp (_, arg, mExprAndArg)) :: otherDelayed) -> - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy pathTypeArgs tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy [] tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_EXTENSIONTYPING @@ -9742,7 +9742,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, pathTypeArgs, afterR | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: otherDelayed) -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy pathTypeArgs tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy [] tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) @@ -9882,7 +9882,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, pathTypeArgs, afterR | ((DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs)) :: (DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty pathTypeArgs tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty [] tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty @@ -15352,12 +15352,12 @@ module TcExceptionDeclarations = ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default longId |> ForceRaise match resolution with - | Item.ExnCase exnc, [], _ -> + | Item.ExnCase exnc, [] -> CheckTyconAccessible cenv.amap m env.eAccessRights exnc |> ignore if not (isNil args') then errorR (Error(FSComp.SR.tcExceptionAbbreviationsShouldNotHaveArgumentList(), m)) TExnAbbrevRepr exnc - | Item.CtorGroup(_, meths), [], _ -> + | Item.CtorGroup(_, meths), [] -> // REVIEW: check this really is an exception type match args' with | [] -> () From 6eda4ceaa0cc23300584ec89eef9ca69f6cf63bc Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 6 Aug 2020 11:08:15 -0700 Subject: [PATCH 80/89] Disallowing operators to come into scope --- src/fsharp/NameResolution.fs | 3 ++- .../Language/OpenTypeDeclarationTests.fs | 19 +++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 3c405737a25..63f8dc20bca 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1025,7 +1025,8 @@ let ChooseMethInfosForNameEnv g m ty (minfos: MethInfo list) = minfos |> List.filter (fun minfo -> not (minfo.IsInstance || minfo.IsClassConstructor || minfo.IsConstructor) && typeEquiv g minfo.ApparentEnclosingType ty && - not (IsMethInfoPlainCSharpStyleExtensionMember g m isExtTy minfo)) + not (IsMethInfoPlainCSharpStyleExtensionMember g m isExtTy minfo) && + not (PrettyNaming.IsMangledOpName minfo.LogicalName)) |> List.groupBy (fun minfo -> minfo.LogicalName) seq { diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index d2ca99552c1..1cea1fd2682 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -1382,6 +1382,25 @@ let main _ = |> shouldSucceed |> ignore + [] + let ``Opened types with operators`` () = + FSharp """ +type A() = + + static member (+) (x: string, y: string) = x + y + +open type A + +[] +let main _ = + let _x = 1 + 1 + 0""" + |> withOptions ["--langversion:preview"] + |> asExe + |> compile + |> shouldSucceed + |> ignore + [] let ``An assembly with an event and field with the same name, favor the field`` () = let ilSource = From 7e88f526f04ce525ecebc96b7110d6c02218dd02 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 6 Aug 2020 11:16:05 -0700 Subject: [PATCH 81/89] Minor refactoring --- src/fsharp/NameResolution.fs | 62 +++++++++++++----------------------- 1 file changed, 23 insertions(+), 39 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 63f8dc20bca..5aa5d4caa1a 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1021,53 +1021,37 @@ let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, che let ChooseMethInfosForNameEnv g m ty (minfos: MethInfo list) = let isExtTy = IsTypeUsedForCSharpStyleExtensionMembers g m ty - let methGroups = - minfos - |> List.filter (fun minfo -> - not (minfo.IsInstance || minfo.IsClassConstructor || minfo.IsConstructor) && typeEquiv g minfo.ApparentEnclosingType ty && - not (IsMethInfoPlainCSharpStyleExtensionMember g m isExtTy minfo) && - not (PrettyNaming.IsMangledOpName minfo.LogicalName)) - |> List.groupBy (fun minfo -> minfo.LogicalName) - - seq { - for (methName, methGroup) in methGroups do - if not methGroup.IsEmpty then - KeyValuePair(methName, Item.MethodGroup(methName, methGroup, None)) - } + minfos + |> List.filter (fun minfo -> + not (minfo.IsInstance || minfo.IsClassConstructor || minfo.IsConstructor) && typeEquiv g minfo.ApparentEnclosingType ty && + not (IsMethInfoPlainCSharpStyleExtensionMember g m isExtTy minfo) && + not (PrettyNaming.IsMangledOpName minfo.LogicalName)) + |> List.groupBy (fun minfo -> minfo.LogicalName) + |> List.filter (fun (_, methGroup) -> not methGroup.IsEmpty) + |> List.map (fun (methName, methGroup) -> KeyValuePair(methName, Item.MethodGroup(methName, methGroup, None))) let ChoosePropInfosForNameEnv g ty (pinfos: PropInfo list) = - let propGroups = - pinfos - |> List.filter (fun pinfo -> - pinfo.IsStatic && typeEquiv g pinfo.ApparentEnclosingType ty) - |> List.groupBy (fun pinfo -> pinfo.PropertyName) - - seq { - for (propName, propGroup) in propGroups do - if not propGroup.IsEmpty then - KeyValuePair(propName, Item.Property(propName, propGroup)) - } + pinfos + |> List.filter (fun pinfo -> + pinfo.IsStatic && typeEquiv g pinfo.ApparentEnclosingType ty) + |> List.groupBy (fun pinfo -> pinfo.PropertyName) + |> List.filter (fun (_, propGroup) -> not propGroup.IsEmpty) + |> List.map (fun (propName, propGroup) -> KeyValuePair(propName, Item.Property(propName, propGroup))) let ChooseFSharpFieldInfosForNameEnv g ty (rfinfos: RecdFieldInfo list) = - seq { - for rfinfo in rfinfos do - if rfinfo.IsStatic && typeEquiv g rfinfo.DeclaringType ty then - KeyValuePair(rfinfo.Name, Item.RecdField rfinfo) - } + rfinfos + |> List.filter (fun rfinfo -> rfinfo.IsStatic && typeEquiv g rfinfo.DeclaringType ty) + |> List.map (fun rfinfo -> KeyValuePair(rfinfo.Name, Item.RecdField rfinfo)) let ChooseILFieldInfosForNameEnv g ty (finfos: ILFieldInfo list) = - seq { - for finfo in finfos do - if finfo.IsStatic && typeEquiv g finfo.ApparentEnclosingType ty then - KeyValuePair(finfo.FieldName, Item.ILField finfo) - } + finfos + |> List.filter (fun finfo -> finfo.IsStatic && typeEquiv g finfo.ApparentEnclosingType ty) + |> List.map (fun finfo -> KeyValuePair(finfo.FieldName, Item.ILField finfo)) let ChooseEventInfosForNameEnv g ty (einfos: EventInfo list) = - seq { - for einfo in einfos do - if einfo.IsStatic && typeEquiv g einfo.ApparentEnclosingType ty then - KeyValuePair(einfo.EventName, Item.Event einfo) - } + einfos + |> List.filter (fun einfo -> einfo.IsStatic && typeEquiv g einfo.ApparentEnclosingType ty) + |> List.map (fun einfo -> KeyValuePair(einfo.EventName, Item.Event einfo)) /// Add content from a type. /// Rules: From 08731c5a97d423723489b1abd415569e6d8c676b Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 6 Aug 2020 11:42:30 -0700 Subject: [PATCH 82/89] Access to record labels and union cases --- src/fsharp/NameResolution.fs | 101 +++++++++--------- .../Language/OpenTypeDeclarationTests.fs | 7 +- 2 files changed, 55 insertions(+), 53 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 5aa5d4caa1a..225511a9e8f 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1053,21 +1053,21 @@ let ChooseEventInfosForNameEnv g ty (einfos: EventInfo list) = |> List.filter (fun einfo -> einfo.IsStatic && typeEquiv g einfo.ApparentEnclosingType ty) |> List.map (fun einfo -> KeyValuePair(einfo.EventName, Item.Event einfo)) -/// Add content from a type. +/// Add static content from a type. /// Rules: -/// 1. Add nested types. -/// 2. Add C# style extension members. -/// 3. Add extention methods. -/// 4. Add extension properties. -/// 5. Add events. -/// 6. Add fields. -/// 7. Add properies. -/// 8. Add methods. +/// 1. Add nested types - access to their constructors. +/// 2. Add static parts of type - i.e. C# style extension members, record labels, and union cases. +/// 3. Add static extention methods. +/// 4. Add static extension properties. +/// 5. Add static events. +/// 6. Add static fields. +/// 7. Add static properies. +/// 8. Add static methods. let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) let nenv = AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty - let nenv = AddCSharpStyleExtensionMembersOfTypeToNameEnv amap m nenv ty + let nenv = AddStaticPartsOfTypeToNameEnv amap m nenv ty // The order of items matter such as intrinsic members will always be favored over extension members of the same name. // Extension property members will always be favored over extenion methods of the same name. @@ -1129,34 +1129,29 @@ and private AddTyconRefsWithEnclosingTypeInstToNameEnv bulkAddMode ownDefinition else { nenv with eUnqualifiedEnclosingTypeInsts = nenv.eUnqualifiedEnclosingTypeInsts.Add tcref tinstEnclosing }) AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs -and private AddCSharpStyleExtensionMembersOfTypeToNameEnv (amap: Import.ImportMap) m nenv ty = +and private AddStaticPartsOfTypeToNameEnv (amap: Import.ImportMap) m nenv ty = match tryTcrefOfAppTy amap.g ty with | ValueSome tcref -> - AddCSharpStyleExtensionMembersOfTyconRefToNameEnv amap m nenv tcref + AddStaticPartsOfTyconRefToNameEnv BulkAdd.Yes false amap.g amap m nenv tcref | _ -> nenv -and private AddCSharpStyleExtensionMembersOfTyconRefToNameEnv amap m nenv (tcref: TyconRef) = +and private AddStaticPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m nenv (tcref: TyconRef) = + let isIL = tcref.IsILTycon + let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef + let flds = if isIL then [| |] else tcref.AllFieldsArray + + // C# style extension members let eIndexedExtensionMembers, eUnindexedExtensionMembers = let ilStyleExtensionMeths = GetCSharpStyleIndexedExtensionMembersForTyconRef amap m tcref ((nenv.eIndexedExtensionMembers, nenv.eUnindexedExtensionMembers), ilStyleExtensionMeths) ||> List.fold (fun (tab1, tab2) extMemInfo -> match extMemInfo with | Choice1Of2 (tcref, extMemInfo) -> tab1.Add (tcref, extMemInfo), tab2 | Choice2Of2 extMemInfo -> tab1, extMemInfo :: tab2) - { nenv with - eIndexedExtensionMembers = eIndexedExtensionMembers - eUnindexedExtensionMembers = eUnindexedExtensionMembers } - -/// Add any implied contents of a type definition to the environment. -and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = - - let isIL = tcref.IsILTycon - let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef - let flds = if isIL then [| |] else tcref.AllFieldsArray - - let nenv = AddCSharpStyleExtensionMembersOfTyconRefToNameEnv amap m nenv tcref let isILOrRequiredQualifiedAccess = isIL || (not ownDefinition && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute tcref.Attribs) + + // Record labels let eFieldLabels = if isILOrRequiredQualifiedAccess || not tcref.IsRecordTycon || flds.Length = 0 then nenv.eFieldLabels @@ -1166,6 +1161,36 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) else AddRecdField (tcref.MakeNestedRecdFieldRef f) acc) let eUnqualifiedItems = + let tab = nenv.eUnqualifiedItems + if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then + tab + else + // Union cases for unqualfied + AddUnionCases2 bulkAddMode tab ucrefs + + let ePatItems = + if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then + nenv.ePatItems + else + // Union cases for patterns + AddUnionCases1 nenv.ePatItems ucrefs + + { nenv with + eFieldLabels = eFieldLabels + eUnqualifiedItems = eUnqualifiedItems + ePatItems = ePatItems + eIndexedExtensionMembers = eIndexedExtensionMembers + eUnindexedExtensionMembers = eUnindexedExtensionMembers } + +and private CanAutoOpenTyconRef (g: TcGlobals) m (tcref: TyconRef) = + g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && + not tcref.IsILTycon && + TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && + tcref.Typars(m).Length = 0 + +/// Add any implied contents of a type definition to the environment. +and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = + let nenv = let tab = nenv.eUnqualifiedItems // add the type name for potential use as a constructor // The rules are @@ -1192,31 +1217,11 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) else tab - let tab = - if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then - tab - else - AddUnionCases2 bulkAddMode tab ucrefs - - tab - - let ePatItems = - if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then - nenv.ePatItems - else - AddUnionCases1 nenv.ePatItems ucrefs - - let nenv = - { nenv with - eFieldLabels = eFieldLabels - eUnqualifiedItems = eUnqualifiedItems - ePatItems = ePatItems } + { nenv with eUnqualifiedItems = tab } + let nenv = AddStaticPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m nenv tcref let nenv = - if amap.g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && - not isIL && - TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && - tcref.Typars(m).Length = 0 then + if CanAutoOpenTyconRef g m tcref then let ty = generalizedTyconRef tcref AddContentOfTypeToNameEnv g amap ad m nenv ty else diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 1cea1fd2682..439bac3b32a 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -995,7 +995,7 @@ module Test2 = |> ignore [] - let ``Open record should have no access to construct record - Errors`` () = + let ``Open record should have access to construct record via labels`` () = FSharp """ namespace FSharpTest @@ -1015,10 +1015,7 @@ module Test2 = """ |> withOptions ["--langversion:preview"] |> compile - |> withDiagnostics - [ - (Error 39, Line 14, Col 15, Line 14, Col 16, "The record label 'X' is not defined.") - ] + |> shouldSucceed |> ignore [] From edab625df429dbe0a2c6750a75b9b66f44cfa947 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 6 Aug 2020 14:10:20 -0700 Subject: [PATCH 83/89] Fixing opening generic types --- src/fsharp/NameResolution.fs | 31 ++++++++++++----------- src/fsharp/NameResolution.fsi | 15 ++++++------ src/fsharp/TypeChecker.fs | 46 ++++++++++++++++++----------------- 3 files changed, 46 insertions(+), 46 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 225511a9e8f..dd1499e80c2 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -139,6 +139,9 @@ type ArgumentContainer = // let (|A|B|) x = if x < 0 then A else B // A and B are reported as results using 'Item.ActivePatternResult' // match () with | A | B -> () // A and B are reported using 'Item.ActivePatternCase' +type EnclosingTypeInst = TypeInst +let emptyEnclosingTypeInst : EnclosingTypeInst = [] + [] /// Represents an item that results from name resolution type Item = @@ -335,7 +338,7 @@ type NameResolutionEnv = eUnqualifiedItems: UnqualifiedItems /// Enclosing type instantiations that are associated with an unqualified type item - eUnqualifiedEnclosingTypeInsts: TyconRefMap + eUnqualifiedEnclosingTypeInsts: TyconRefMap /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap @@ -2087,7 +2090,7 @@ let CheckAllTyparsInferrable amap m item = /// ultimately calls ResolutionInfo.Method to record it for /// later use by Visual Studio. type ResolutionInfo = - | ResolutionInfo of (*entityPath, reversed*)(range * EntityRef) list * (*warnings/errors*)(ResultTyparChecker -> unit) * tinstEnclosing: TypeInst + | ResolutionInfo of (*entityPath, reversed*)(range * EntityRef) list * (*warnings/errors*)(ResultTyparChecker -> unit) * tinstEnclosing: EnclosingTypeInst static member SendEntityPathToSink(sink, ncenv: NameResolver, nenv, occ, ad, ResolutionInfo(entityPath, warnings, _), typarChecker) = entityPath |> List.iter (fun (m, eref: EntityRef) -> @@ -2102,7 +2105,7 @@ type ResolutionInfo = warnings typarChecker static member Empty = - ResolutionInfo([], (fun _ -> ()), []) + ResolutionInfo([], (fun _ -> ()), emptyEnclosingTypeInst) member x.AddEntity info = let (ResolutionInfo(entityPath, warnings, tinstEnclosing)) = x @@ -2752,7 +2755,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified match AtMostOneResult m search with | Result (resInfo, item) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - Some(item, rest) + Some(resInfo.EnclosingTypeInst, item, rest) | Exception e -> typeError <- Some e None @@ -2766,8 +2769,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // Do not resolve `nameof` if the feature is unsupported, even if it is FSharp.Core None else - Some (fresh, rest) - | _ -> Some (fresh, rest) + Some (emptyEnclosingTypeInst, fresh, rest) + | _ -> Some (emptyEnclosingTypeInst, fresh, rest) | _ -> None @@ -2826,7 +2829,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | Exception e -> raze e | Result (resInfo, item) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - success (item, rest) + success (resInfo.EnclosingTypeInst, item, rest) // A compound identifier. // It still might be a value in the environment, or something in an F# module, namespace, type, or nested type @@ -2844,7 +2847,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | _ -> false if ValIsInEnv id.idText then - success (nenv.eUnqualifiedItems.[id.idText], rest) + success (emptyEnclosingTypeInst, nenv.eUnqualifiedItems.[id.idText], rest) else // 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. @@ -2917,7 +2920,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | Exception e -> raze e | Result (resInfo, item, rest) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - success (item, rest) + success (resInfo.EnclosingTypeInst, item, rest) let ResolveExprLongIdent sink (ncenv: NameResolver) m ad nenv typeNameResInfo lid = match lid with @@ -3312,10 +3315,6 @@ let ResolveTypeLongIdentAux sink (ncenv: NameResolver) occurence fullyQualified /// Resolve a long identifier representing a type and report it let ResolveTypeLongIdent sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk = - let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk - (res |?> snd) - -let ResolveTypeLongIdentAndEnclosingTypeInst sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk = let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk (res |?> fun (resInfo, tcref) -> (resInfo.EnclosingTypeInst, tcref)) @@ -3588,7 +3587,7 @@ type AfterResolution = let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv typeNameResInfo lid = match ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid with | Exception e -> Exception e - | Result (item1, rest) -> + | Result (tinstEnclosing, item1, rest) -> let itemRange = ComputeItemRange wholem lid rest let item = FilterMethodGroups ncenv itemRange item1 true @@ -3636,7 +3635,7 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso callSink (item, emptyTyparInst) AfterResolution.DoNothing - success (item, itemRange, rest, afterResolution) + success (tinstEnclosing, item, itemRange, rest, afterResolution) let (|NonOverridable|_|) namedItem = match namedItem with @@ -3697,7 +3696,7 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes callSink (unrefinedItem, emptyTyparInst) AfterResolution.DoNothing - item, itemRange, rest, resInfo.EnclosingTypeInst, afterResolution + resInfo.EnclosingTypeInst, item, itemRange, rest, afterResolution //------------------------------------------------------------------------- diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 1ae4afc7457..1301379a8e4 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -39,6 +39,8 @@ type ArgumentContainer = /// When reporting symbols, we care about abbreviations, e.g. 'int' and 'int32' count as two separate symbols. val (|AbbrevOrAppTy|_|) : TType -> TyconRef option +type EnclosingTypeInst = TypeInst + [] /// Represents an item that results from name resolution type Item = @@ -161,7 +163,7 @@ type NameResolutionEnv = eUnqualifiedItems: LayeredMap /// Enclosing type instantiations that are associated with an unqualified type item - eUnqualifiedEnclosingTypeInsts: TyconRefMap + eUnqualifiedEnclosingTypeInsts: TyconRefMap /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap @@ -548,16 +550,13 @@ val internal ResolvePatternLongIdent : TcResultsSink -> NameResol val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResolver -> NameResolutionEnv -> TypeNameResolutionInfo -> AccessorDomain -> range -> ModuleOrNamespaceRef -> Ident list -> TyconRef /// Resolve a long identifier to a type definition -val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException - -/// Resolve a long identifier to a type definition with enclosing type instantiations. -val internal ResolveTypeLongIdentAndEnclosingTypeInst : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException +val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException /// Resolve a long identifier to a field val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list /// Resolve a long identifier occurring in an expression position -val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException +val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException /// Resolve a (possibly incomplete) long identifier to a loist of possible class or record fields val internal ResolvePartialLongIdentToClassOrRecdFields : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> bool -> Item list @@ -583,10 +582,10 @@ type AfterResolution = | RecordResolution of Item option * (TyparInst -> unit) * (MethInfo * PropInfo option * TyparInst -> unit) * (unit -> unit) /// Resolve a long identifier occurring in an expression position. -val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException +val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException /// Resolve a long identifier occurring in an expression position, qualified by a type. -val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> TypeNameResolutionInfo -> FindMemberFlag -> bool -> Item * range * Ident list * TypeInst * AfterResolution +val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> TypeNameResolutionInfo -> FindMemberFlag -> bool -> EnclosingTypeInst * Item * range * Ident list * AfterResolution /// A generator of type instantiations used when no more specific type instantiation is known. val FakeInstantiationGenerator : range -> Typar list -> TType list diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 23051fcd056..d875f3a2415 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -901,7 +901,7 @@ let TcConst cenv ty m env c = | SynMeasure.One -> Measure.One | SynMeasure.Named(tc, m) -> let ad = env.eAccessRights - let tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Use OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let _, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Use OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) match tcref.TypeOrMeasureKind with | TyparKind.Type -> error(Error(FSComp.SR.tcExpectedUnitOfMeasureNotType(), m)) | TyparKind.Measure -> Measure.Con tcref @@ -3213,7 +3213,7 @@ let (|JoinRelation|_|) cenv env (e: SynExpr) = let isOpName opName vref s = (s = opName) && match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default [ident(opName, m)] with - | Result (Item.Value vref2, []) -> valRefEq cenv.g vref vref2 + | Result (_, Item.Value vref2, []) -> valRefEq cenv.g vref vref2 | _ -> false match e with @@ -4671,7 +4671,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope | SynType.LongIdent(LongIdentWithDots(tc, _) as lidwd) -> let m = lidwd.Range let ad = env.eAccessRights - let tinstEnclosing, tcref = ForceRaise(ResolveTypeLongIdentAndEnclosingTypeInst cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let tinstEnclosing, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) match optKind, tcref.TypeOrMeasureKind with | Some TyparKind.Type, TyparKind.Measure -> error(Error(FSComp.SR.tcExpectedTypeNotUnitOfMeasure(), m)) @@ -4689,7 +4689,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope let tinstEnclosing, tcref = let tyResInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length - ResolveTypeLongIdentAndEnclosingTypeInst cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No + ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No |> ForceRaise match optKind, tcref.TypeOrMeasureKind with @@ -5433,7 +5433,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p id.idText = "nameof" && try match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.NameEnv TypeNameResolutionInfo.Default [id] with - | Result (Item.Value vref, _) -> valRefEq cenv.g vref cenv.g.nameof_vref + | Result (_, Item.Value vref, _) -> valRefEq cenv.g vref cenv.g.nameof_vref | _ -> false with _ -> false @@ -9329,7 +9329,7 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId let resolvesAsExpr = match nameResolutionResult with - | Result ((item, _, _, _) as res) + | Result ((_, item, _, _, _) as res) when (match item with | Item.Types _ @@ -9349,10 +9349,10 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = if (match delayed with [DelayedTypeApp _] | [] -> true | _ -> false) then let (TypeNameResolutionInfo(_, staticArgsInfo)) = GetLongIdentTypeNameInfo delayed match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with - | Result tcref when IsEntityAccessible cenv.amap m ad tcref -> + | Result (tinstEnclosing, tcref) when IsEntityAccessible cenv.amap m ad tcref -> match delayed with | [DelayedTypeApp (tyargs, _, mExprAndTypeArgs)] -> - TcTypeApp cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs tcref [] tyargs |> ignore + TcTypeApp cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs tcref tinstEnclosing tyargs |> ignore | _ -> () true // resolved to a type name, done with checks | _ -> @@ -9482,7 +9482,7 @@ and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) dela // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) delayed = +and TcItemThen cenv overallTy env tpenv (tinstEnclosing, item, mItem, rest, afterResolution) delayed = let g = cenv.g let delayed = delayRest rest mItem delayed let ad = env.eAccessRights @@ -9638,14 +9638,14 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty [] tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs // Report information about the whole expression including type arguments to VS let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed - let item, mItem, rest, _, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true - TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) otherDelayed + let _, item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true + TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! @@ -10105,7 +10105,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela if isTyparTy cenv.g objExprTy then ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight cenv.g false objExprTy) - let item, mItem, rest, _, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false + let _, item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false let mExprAndItem = unionRanges mObjExpr mItem let delayed = delayRest rest mExprAndItem delayed @@ -15352,12 +15352,12 @@ module TcExceptionDeclarations = ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default longId |> ForceRaise match resolution with - | Item.ExnCase exnc, [] -> + | _, Item.ExnCase exnc, [] -> CheckTyconAccessible cenv.amap m env.eAccessRights exnc |> ignore if not (isNil args') then errorR (Error(FSComp.SR.tcExceptionAbbreviationsShouldNotHaveArgumentList(), m)) TExnAbbrevRepr exnc - | Item.CtorGroup(_, meths), [] -> + | _, Item.CtorGroup(_, meths), [] -> // REVIEW: check this really is an exception type match args' with | [] -> () @@ -15791,7 +15791,7 @@ module EstablishTypeDefinitionCores = | Some (tc, args, m) -> let ad = envinner.eAccessRights match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified envinner.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.Yes with - | Result tcrefBeforeStaticArguments when + | Result (_, tcrefBeforeStaticArguments) when tcrefBeforeStaticArguments.IsProvided && not tcrefBeforeStaticArguments.IsErased -> @@ -16885,12 +16885,14 @@ module TcDeclarations = | _ -> let resInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs synTypars.Length - match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.eNameResEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with - | Result res -> res - | res when inSig && longPath.Length = 1 -> - errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m)) - ForceRaise res - | res -> ForceRaise res + let _, tcref = + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.eNameResEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with + | Result res -> res + | res when inSig && longPath.Length = 1 -> + errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m)) + ForceRaise res + | res -> ForceRaise res + tcref let isInterfaceOrDelegateOrEnum = tcref.Deref.IsFSharpInterfaceTycon || From 07bd541991ec39e5f8ac4f4d00168d0f03113732 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 6 Aug 2020 14:50:19 -0700 Subject: [PATCH 84/89] Do not need to return enclosing type instantiations from a dot --- src/fsharp/NameResolution.fs | 2 +- src/fsharp/NameResolution.fsi | 2 +- src/fsharp/TypeChecker.fs | 12 ++++++------ 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index dd1499e80c2..5b82950245e 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -3696,7 +3696,7 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes callSink (unrefinedItem, emptyTyparInst) AfterResolution.DoNothing - resInfo.EnclosingTypeInst, item, itemRange, rest, afterResolution + item, itemRange, rest, afterResolution //------------------------------------------------------------------------- diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 1301379a8e4..da55f262828 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -585,7 +585,7 @@ type AfterResolution = val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException /// Resolve a long identifier occurring in an expression position, qualified by a type. -val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> TypeNameResolutionInfo -> FindMemberFlag -> bool -> EnclosingTypeInst * Item * range * Ident list * AfterResolution +val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> TypeNameResolutionInfo -> FindMemberFlag -> bool -> Item * range * Ident list * AfterResolution /// A generator of type instantiations used when no more specific type instantiation is known. val FakeInstantiationGenerator : range -> Typar list -> TType list diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index d875f3a2415..d703fe8ec9a 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -9644,12 +9644,12 @@ and TcItemThen cenv overallTy env tpenv (tinstEnclosing, item, mItem, rest, afte let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed - let _, item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true + let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: _delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty [] tyargs + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) @@ -9721,7 +9721,7 @@ and TcItemThen cenv overallTy env tpenv (tinstEnclosing, item, mItem, rest, afte | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: (DelayedApp (_, arg, mExprAndArg)) :: otherDelayed) -> - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy [] tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_EXTENSIONTYPING @@ -9742,7 +9742,7 @@ and TcItemThen cenv overallTy env tpenv (tinstEnclosing, item, mItem, rest, afte | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs)) :: otherDelayed) -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy [] tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) @@ -9882,7 +9882,7 @@ and TcItemThen cenv overallTy env tpenv (tinstEnclosing, item, mItem, rest, afte | ((DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs)) :: (DelayedApp (atomicFlag, arg, mItemAndArg)) :: otherDelayed) -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty [] tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty tinstEnclosing tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty @@ -10105,7 +10105,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela if isTyparTy cenv.g objExprTy then ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight cenv.g false objExprTy) - let _, item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false + let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false let mExprAndItem = unionRanges mObjExpr mItem let delayed = delayRest rest mExprAndItem delayed From 6ec6a41332dc12ef8c5bbecd10fa36e486624412 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 6 Aug 2020 15:27:23 -0700 Subject: [PATCH 85/89] Added generic union and record tests --- .../Language/OpenTypeDeclarationTests.fs | 50 +++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 439bac3b32a..36cf2e8bedf 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -994,6 +994,32 @@ module Test2 = |> shouldSucceed |> ignore + [] + let ``Open generic union should have access to union cases with the enclosing type instantiations`` () = + FSharp """ +namespace FSharpTest + +module Test = + + type TestUnion<'T> = + | UCase1 of 'T + | UCase2 with + + static member M() = () + +open type Test.TestUnion + +module Test2 = + + let x = UCase1 "" + + let y = M() + """ + |> withOptions ["--langversion:preview"] + |> compile + |> shouldFail + |> ignore + [] let ``Open record should have access to construct record via labels`` () = FSharp """ @@ -1018,6 +1044,30 @@ module Test2 = |> shouldSucceed |> ignore + [] + let ``Open generic record should have access to construct record via labels with enclosing type instantiations`` () = + FSharp """ +namespace FSharpTest + +module Test = + + type TestRecord<'T> = { X: 'T } with + + static member M() = () + +open type Test.TestRecord + +module Test2 = + + let x = { X = "" } + + let y = M() + """ + |> withOptions ["--langversion:preview"] + |> compile + |> shouldFail + |> ignore + [] let ``Open type should have no access to constructor - Errors`` () = FSharp """ From 9d3b4bd7c07fa26d8e9a3e71e72e0bcf6e4c00cd Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 10 Aug 2020 14:59:35 -0700 Subject: [PATCH 86/89] Combining intrinsic and extension method groups. Ignoring generic record/union tests. --- src/fsharp/NameResolution.fs | 36 ++++++++--- .../Language/OpenTypeDeclarationTests.fs | 62 ++++++++++++++++++- 2 files changed, 86 insertions(+), 12 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 5b82950245e..fad5d71a6ed 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1065,8 +1065,8 @@ let ChooseEventInfosForNameEnv g ty (einfos: EventInfo list) = /// 5. Add static events. /// 6. Add static fields. /// 7. Add static properies. -/// 8. Add static methods. -let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = +/// 8. Add static methods and combine extension methods of the same group. +let rec AddStaticContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (ty: TType) = let infoReader = InfoReader(g,amap) let nenv = AddNestedTypesOfTypeToNameEnv infoReader amap ad m nenv ty @@ -1105,14 +1105,30 @@ let rec AddContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (n yield! IntrinsicPropInfosOfTypeInScope infoReader None ad PreferOverrides m ty |> ChoosePropInfosForNameEnv g ty - - // Methods - yield! - IntrinsicMethInfosOfType infoReader None ad AllowMultiIntfInstantiations.Yes PreferOverrides m ty - |> ChooseMethInfosForNameEnv g m ty |] - { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } + let nenv = { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } + + let methodGroupItems = + // Methods + IntrinsicMethInfosOfType infoReader None ad AllowMultiIntfInstantiations.Yes PreferOverrides m ty + |> ChooseMethInfosForNameEnv g m ty + // Combine methods and extension method groups of the same type + |> List.map (fun pair -> + match pair.Value with + | Item.MethodGroup(name, methInfos, orig) -> + match nenv.eUnqualifiedItems.TryFind pair.Key with + // First method of the found group must be an extension and have the same enclosing type as the type we are opening. + // If the first method is an extension, we are assuming the rest of the methods in the group are also extensions. + | Some(Item.MethodGroup(_, ((methInfo :: _) as methInfos2), _)) when methInfo.IsExtensionMember && typeEquiv g methInfo.ApparentEnclosingType ty -> + KeyValuePair (pair.Key, Item.MethodGroup(name, methInfos @ methInfos2, orig)) + | _ -> + pair + | _ -> + pair) + |> Array.ofList + + { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible methodGroupItems } and private AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad m nenv ty = let tinst, tcrefs = GetNestedTyconRefsOfType infoReader amap (ad, None, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty @@ -1226,7 +1242,7 @@ and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) let nenv = if CanAutoOpenTyconRef g m tcref then let ty = generalizedTyconRef tcref - AddContentOfTypeToNameEnv g amap ad m nenv ty + AddStaticContentOfTypeToNameEnv g amap ad m nenv ty else nenv @@ -1358,7 +1374,7 @@ and AddModuleOrNamespaceRefsContentsToNameEnv g amap ad m root nenv modrefs = and AddTypeContentsToNameEnv g amap ad m nenv (typ: TType) = assert (isAppTy g typ) assert not (tcrefOfAppTy g typ).IsModuleOrNamespace - AddContentOfTypeToNameEnv g amap ad m nenv typ + AddStaticContentOfTypeToNameEnv g amap ad m nenv typ and AddModuleOrNamespaceRefContentsToNameEnv g amap ad m root nenv (modref: EntityRef) = assert modref.IsModuleOrNamespace diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 36cf2e8bedf..92e806bd111 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -994,7 +994,7 @@ module Test2 = |> shouldSucceed |> ignore - [] + [] let ``Open generic union should have access to union cases with the enclosing type instantiations`` () = FSharp """ namespace FSharpTest @@ -1044,7 +1044,7 @@ module Test2 = |> shouldSucceed |> ignore - [] + [] let ``Open generic record should have access to construct record via labels with enclosing type instantiations`` () = FSharp """ namespace FSharpTest @@ -1092,6 +1092,64 @@ module Test2 = |> withErrorCode 39 |> ignore + [] + let ``Open type should combine both extension and intrinsic method groups`` () = + FSharp """ +namespace FSharpTest + +type Test = + + static member M(_x: int) = () + +module Test = + + type Test with + + static member M(_x: float) : int = 5 + +open Test +open type Test + +module Test2 = + + let test () : int = + M(1) + M(2.0) + """ + |> withOptions ["--langversion:preview"] + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Open type should combine both extension and intrinsic method groups but error if extensions are added after opening the type`` () = + FSharp """ +namespace FSharpTest + +type Test = + + static member M(_x: int) = () + +module Test = + + type Test with + + static member M(_x: float) : int = 5 + +open type Test +open Test + +module Test2 = + + let test () : int = + M(1) + M(2.0) + """ + |> withOptions ["--langversion:preview"] + |> compile + |> withErrorCodes [1;1] + |> ignore + [] let ``Using the 'open' declaration on a possible type identifier - Error`` () = let csharp = From ff3975fbef668d306c206ebe297ea7fc24a8a4bb Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 10 Aug 2020 15:31:09 -0700 Subject: [PATCH 87/89] Update FSComp.txt.ja.xlf --- src/fsharp/xlf/FSComp.txt.ja.xlf | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 40298c72f3d..5a898f407bc 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -122,11 +122,6 @@ open type declaration - - open static classes - 静的クラスを開く - - package management パッケージの管理 @@ -7539,4 +7534,4 @@ - \ No newline at end of file + From 584808791094382107a412fbf5c9907635c6c01f Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 10 Aug 2020 15:42:37 -0700 Subject: [PATCH 88/89] Fixing build --- src/fsharp/TypeChecker.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 3cd0664242c..adba0794ac2 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -5947,7 +5947,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = TcConstStringExpr cenv overallTy env m tpenv s | SynExpr.InterpolatedString (parts, m) -> - tryLanguageFeatureError cenv.g.langVersion LanguageFeature.StringInterpolation m + checkLanguageFeatureError cenv.g.langVersion LanguageFeature.StringInterpolation m CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.AccessRights) From 1151da521d3621600076f2a0cae02a2515f6daff Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 10 Aug 2020 16:03:07 -0700 Subject: [PATCH 89/89] Update OpenTypeDeclarationTests.fs --- tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs index 92e806bd111..7bde3781e72 100644 --- a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -2101,7 +2101,7 @@ let main _ = """ let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp31) |> CompilationReference.Create let fsCmpl = @@ -2143,7 +2143,7 @@ let main _ = """ let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp31) |> CompilationReference.Create let fsCmpl = @@ -2182,7 +2182,7 @@ let main _ = """ let csCmpl = - CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp30) + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp31) |> CompilationReference.Create let fsCmpl =