diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index fbbda436e58..5b99d903d86 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -5635,7 +5635,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 tcEnv (pathToSynLid initm (splitNamespace FSharpLib.CoreOperatorsCheckedName), initm) with e -> errorRecovery e initm; tcEnv else tcEnv @@ -5792,7 +5792,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 tcEnv (prefixPath, m) let tcState = { tcState with @@ -5840,13 +5840,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 tcImplEnv (prefixPath, m) | _ -> 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 tcSigEnv (prefixPath, m) | _ -> tcSigEnv let ccuSig = CombineCcuContentFragments m [implFileSigType; tcState.tcsCcuSig ] 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 c7974e5c20e..7705278dcee 100644 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -691,12 +691,12 @@ let private tryLanguageFeatureErrorAux (langVersion: LanguageVersion) (langFeatu else None -let internal tryLanguageFeatureError langVersion langFeature m = +let internal checkLanguageFeatureError langVersion langFeature m = match tryLanguageFeatureErrorAux langVersion langFeature m with | Some e -> error (e) | None -> () -let internal tryLanguageFeatureErrorRecover langVersion langFeature m = +let internal checkLanguageFeatureErrorRecover langVersion langFeature m = match tryLanguageFeatureErrorAux langVersion langFeature m with | Some e -> errorR e | None -> () diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 2733248bea1..0505c47b289 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1480,6 +1480,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" @@ -1502,7 +1503,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 222a2557890..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 @@ -922,5 +928,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/LanguageFeatures.fs b/src/fsharp/LanguageFeatures.fs index 8c8330ea4d1..de0ae2ed8f6 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 @@ -67,7 +67,7 @@ type LanguageVersion (specifiedVersionAsString) = // F# preview LanguageFeature.FromEndSlicing, previewVersion - LanguageFeature.OpenStaticClasses, previewVersion + LanguageFeature.OpenTypeDeclaration, previewVersion LanguageFeature.PackageManagement, previewVersion LanguageFeature.WitnessPassing, previewVersion LanguageFeature.InterfacesWithMultipleGenericInstantiation, previewVersion @@ -133,7 +133,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 95ad370a5e7..9dbfccea942 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 441c999d75d..492e3af96a6 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -1752,8 +1752,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..d5105e649dc 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 @@ -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 aeea7556172..fad5d71a6ed 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 = @@ -334,6 +337,9 @@ type NameResolutionEnv = /// Values, functions, methods and other items available by unqualified name eUnqualifiedItems: UnqualifiedItems + /// 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 @@ -392,6 +398,7 @@ type NameResolutionEnv = eFullyQualifiedModulesAndNamespaces = Map.empty eFieldLabels = Map.empty eUnqualifiedItems = LayeredMap.Empty + eUnqualifiedEnclosingTypeInsts = TyconRefMap.Empty ePatItems = Map.empty eTyconsByAccessNames = LayeredMultiMap.Empty eTyconsByDemangledNameAndArity = LayeredMap.Empty @@ -437,23 +444,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 isEnclExtTy (minfo: MethInfo) = + // Method must be static, have 'Extension' attribute, must not be curried, must have at least one argument + isEnclExtTy && + 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. @@ -729,7 +750,7 @@ let AddTyconsByDemangledNameAndArity (bulkAddMode: BulkAdd) (tcrefs: TyconRef[]) 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.KeyTyconByDecodedName tcref.LogicalName tcref) match bulkAddMode with | BulkAdd.Yes -> tab.AddAndMarkAsCollapsible entries @@ -770,59 +791,386 @@ 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) = - // 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)) - |] - - { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } - else - nenv +//------------------------------------------------------------------------- +// 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 = DecodeGenericTypeNameWithPos 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 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 + argsOfAppTy g ty, + infoReader.GetPrimaryTypeHierarchy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> + match ty with + | AppTy g (tcref, _) -> + 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) + | 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) ] + + | _ -> +#endif + mty.TypesByAccessNames.Values + |> List.choose (fun entity -> + let tcref = tcref.NestedTyconRef entity + if IsEntityAccessible amap m ad tcref then Some 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 = + 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 + + 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) = + 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) = + 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) = + 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) = + einfos + |> List.filter (fun einfo -> einfo.IsStatic && typeEquiv g einfo.ApparentEnclosingType ty) + |> List.map (fun einfo -> KeyValuePair(einfo.EventName, Item.Event einfo)) + +/// Add static content from a type. +/// Rules: +/// 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 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 + 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. + let items = + [| + // Extension methods + yield! + ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None m ty + |> ChooseMethInfosForNameEnv g m ty + + // Extension properties + yield! + ExtensionPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad m ty + |> ChoosePropInfosForNameEnv g ty + + // Events + yield! + infoReader.GetEventInfosOfType(None, ad, m, ty) + |> ChooseEventInfosForNameEnv g ty + + // FSharp fields + yield! + infoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) + |> ChooseFSharpFieldInfosForNameEnv g ty + + // IL fields + yield! + infoReader.GetILFieldInfosOfType(None, ad, m, ty) + |> ChooseILFieldInfosForNameEnv g ty + + // Properties + yield! + IntrinsicPropInfosOfTypeInScope infoReader None ad PreferOverrides m ty + |> ChoosePropInfosForNameEnv g ty + |] + + 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 } -/// 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 AddNestedTypesOfTypeToNameEnv infoReader (amap: Import.ImportMap) ad m nenv ty = + 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) -> + AddTyconRefsWithEnclosingTypeInstToNameEnv BulkAdd.Yes false amap.g amap ad m false nenv (tinst, tcrefs)) + +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 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 AddStaticPartsOfTypeToNameEnv (amap: Import.ImportMap) m nenv ty = + match tryTcrefOfAppTy amap.g ty with + | ValueSome tcref -> + AddStaticPartsOfTyconRefToNameEnv BulkAdd.Yes false amap.g amap m nenv tcref + | _ -> + nenv + +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 + 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 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 @@ -832,6 +1180,36 @@ let 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 @@ -852,44 +1230,26 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) if mayHaveConstruction then tab.LinearTryModifyThenLaterFlatten (tcref.DisplayName, (fun prev -> - match prev with - | Some (Item.UnqualifiedType tcrefs) -> Item.UnqualifiedType (tcref :: tcrefs) - | _ -> Item.UnqualifiedType [tcref])) - 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 + match prev with + | Some (Item.UnqualifiedType tcrefs) -> Item.UnqualifiedType (tcref :: tcrefs) + | _ -> Item.UnqualifiedType [tcref])) + else + tab - let nenv = - { nenv with - eFieldLabels = eFieldLabels - eUnqualifiedItems = eUnqualifiedItems - ePatItems = ePatItems - eIndexedExtensionMembers = eIndexedExtensionMembers - eUnindexedExtensionMembers = eUnindexedExtensionMembers } + { nenv with eUnqualifiedItems = tab } + let nenv = AddStaticPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m nenv tcref let nenv = - if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && isStaticClass g tcref then - AddStaticContentOfTyconRefToNameEnv g amap ad m nenv tcref + if CanAutoOpenTyconRef g m tcref then + let ty = generalizedTyconRef tcref + AddStaticContentOfTypeToNameEnv g amap ad m nenv ty else - nenv + nenv 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 @@ -1008,14 +1368,17 @@ 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 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 +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 + +and AddModuleOrNamespaceRefContentsToNameEnv g amap ad m root nenv (modref: EntityRef) = + 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) = @@ -1048,12 +1411,20 @@ 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 type into a type that includes +/// 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 /// a fresh set of inference type variables for the type parameters of the union type. let FreshenUnionCaseRef (ncenv: NameResolver) m (ucref: UnionCaseRef) = @@ -1145,115 +1516,25 @@ let AtMostOneResultQuery query2 res1 = let inline (+++) res1 query2 = AtMostOneResultQuery query2 res1 //------------------------------------------------------------------------- -// 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) - - -//------------------------------------------------------------------------- -// Resolve (possibly mangled) type names +// Resolve (possibly mangled) type names in environment //------------------------------------------------------------------------- -/// 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) = 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 | 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 +1542,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. @@ -1423,20 +1568,20 @@ 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.ModuleOrNamespace (range=m) + | SynOpenDeclTarget.Type (range=m) -> Some m + Types = types Modules = modules AppliedScope = appliedScope IsOwnNamespace = isOwnNamespace } @@ -1961,9 +2106,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) * tinstEnclosing: EnclosingTypeInst - 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 @@ -1976,17 +2121,23 @@ type ResolutionInfo = warnings typarChecker static member Empty = - ResolutionInfo([], (fun _ -> ())) + ResolutionInfo([], (fun _ -> ()), emptyEnclosingTypeInst) member x.AddEntity info = - let (ResolutionInfo(entityPath, warnings)) = x - ResolutionInfo(info :: entityPath, warnings) + let (ResolutionInfo(entityPath, warnings, tinstEnclosing)) = x + ResolutionInfo(info :: entityPath, warnings, tinstEnclosing) member x.AddWarning f = - let (ResolutionInfo(entityPath, warnings)) = x - ResolutionInfo(entityPath, (fun typarChecker -> f typarChecker; warnings typarChecker)) + let (ResolutionInfo(entityPath, warnings, tinstEnclosing)) = x + ResolutionInfo(entityPath, (fun typarChecker -> f typarChecker; warnings typarChecker), tinstEnclosing) + member x.WithEnclosingTypeInst tinstEnclosing = + let (ResolutionInfo(entityPath, warnings, _)) = x + ResolutionInfo(entityPath, warnings, tinstEnclosing) + member x.EnclosingTypeInst = + match x with + | 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. @@ -2010,24 +2161,24 @@ 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 - | ((_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.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 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 @@ -2049,31 +2200,34 @@ 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 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 +/// 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 = 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( - 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(0, FSComp.SR.undefinedNameNamespaceOrModule, id, suggestModulesAndNamespaces)) + UndefinedName(depth, error, id, suggestNames) + + let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified + let namespaceNotFound = + lazy + 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. @@ -2082,13 +2236,11 @@ let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: Resul 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 = + 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 @@ -2097,60 +2249,43 @@ let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: Resul let occurence = if isOpenDecl then ItemOccurence.Open else ItemOccurence.Use CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occurence, ad) - let erefs = - let modrefs = - 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 + 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 allowStaticClasses (modref: ModuleOrNamespaceRef) (lid: Ident list) = + let rec look depth (modref: ModuleOrNamespaceRef) (lid: Ident list) = let mty = modref.ModuleOrNamespaceType match lid with | [] -> success [ (depth, modref, mty) ] | id :: rest -> - let especs = - let mspecs = - 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 + 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 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 else moduleNotFound modref mty id depth - erefs - |> 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 + 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 @@ -2158,8 +2293,8 @@ let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: Resul raze (namespaceNotFound.Force()) // 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 +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 | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), id.idRange)) @@ -2278,6 +2413,13 @@ let GetRecordLabelsForType g nenv ty = result.Add k |> ignore result +/// Get the nested types of the given type and check the nested types based on the type name resolution info. +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) + 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 = @@ -2353,7 +2495,7 @@ 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 nestedTypes = CheckNestedTypesOfType ncenv resInfo ad nm typeNameResInfo m ty if isNil nestedTypes then NoResultsOrUsefulErrors else @@ -2365,7 +2507,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 = 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 @@ -2428,12 +2570,15 @@ 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 = @@ -2484,7 +2629,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 @@ -2549,24 +2694,43 @@ 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 tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) +let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, tcrefs) = let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) + + let tys = + tcrefs + |> List.map (fun (resInfo, tcref) -> + match resInfo.EnclosingTypeInst with + | [] -> + (resInfo, FreshenTycon ncenv m tcref) + | tinstEnclosing -> + (resInfo, FreshenTyconWithEnclosingTypeInst ncenv m tinstEnclosing tcref)) + match typeNameResInfo.ResolutionFlag with | ResolveTypeNamesToCtors -> - let tys = tcrefs |> List.map (fun (resInfo, tcref) -> (resInfo, FreshenTycon ncenv m tcref)) 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) -> (resInfo, FreshenTycon ncenv m tcref)) - success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty]), []))) + success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty])))) + +/// Resolves the given tycons. +/// 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 @@ -2597,15 +2761,17 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // 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 -> + tcrefs + |> ResolveUnqualifiedTyconRefs nenv + |> List.filter (fun (resInfo, tcref) -> typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || - typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length) + typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length) - let search = ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) + 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) + Some(resInfo.EnclosingTypeInst, item, rest) | Exception e -> typeError <- Some e None @@ -2619,8 +2785,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 (emptyEnclosingTypeInst, fresh, rest) + | _ -> Some (emptyEnclosingTypeInst, fresh, rest) | _ -> None @@ -2630,12 +2796,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 - ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) + let tcrefs = + LookupTypeNameInEnvMaybeHaveArity fullyQualified id.idText typeNameResInfo nenv + |> ResolveUnqualifiedTyconRefs nenv + ChooseTyconRefInExpr (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 @@ -2675,9 +2843,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) + 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 @@ -2695,24 +2863,25 @@ 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. 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. // 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 -> (resInfo, tcref)) + let tcrefs = ResolveUnqualifiedTyconRefs nenv tcrefs let tcrefs = - let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.Indefinite) + 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 | _ -> @@ -2727,7 +2896,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 @@ -2767,7 +2936,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 @@ -2885,7 +3054,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 = @@ -2955,7 +3124,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)) @@ -2970,12 +3139,12 @@ 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) | [] -> 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)) @@ -3039,7 +3208,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)) @@ -3060,7 +3229,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.eUnqualifiedEnclosingTypeInsts.TryFind res with + | Some tinst -> ResolutionInfo.Empty.WithEnclosingTypeInst tinst + | _ -> ResolutionInfo.Empty + | _ -> + ResolutionInfo.Empty + let res = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities ([(resInfo, res)], typeNameResInfo, genOk, unionRanges m id.idRange) assert (res.Length = 1) success res.Head | None -> @@ -3091,20 +3268,24 @@ 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 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 @@ -3130,7 +3311,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 @@ -3146,7 +3327,12 @@ 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 |?> fun (resInfo, tcref) -> (resInfo.EnclosingTypeInst, tcref)) //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in records etc. @@ -3306,7 +3492,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 = @@ -3343,8 +3529,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 _ -> @@ -3418,7 +3603,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 @@ -3466,7 +3651,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 @@ -3476,12 +3661,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 @@ -3602,7 +3787,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 @@ -4151,7 +4336,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 @@ -4312,7 +4497,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 @@ -4670,7 +4855,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 -> @@ -4745,7 +4930,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 7caa8321a02..da55f262828 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 = @@ -160,6 +162,9 @@ type NameResolutionEnv = /// Values and Data Tags available by unqualified name eUnqualifiedItems: LayeredMap + /// 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 @@ -242,7 +247,10 @@ 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 /// A flag which indicates if it is an error to have two declared type parameters with identical names /// in the name resolution environment. @@ -373,8 +381,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 +390,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 +400,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 = @@ -523,8 +534,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 @@ -539,13 +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 +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 @@ -571,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 -> 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/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index 89c841ea40b..2a6d0a64d89 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -514,19 +514,24 @@ let TryDemangleGenericNameAndPos (n: string) = type NameArityPair = NameArityPair of string * int -let DecodeGenericTypeName pos (mangledName: string) = - let res = mangledName.Substring(0, pos) - let num = mangledName.Substring(pos+1, mangledName.Length - pos - 1) - NameArityPair(res, int32 num) - let DemangleGenericTypeNameWithPos pos (mangledName: string) = mangledName.Substring(0, pos) +let DecodeGenericTypeNameWithPos pos (mangledName: string) = + let res = DemangleGenericTypeNameWithPos pos mangledName + let num = mangledName.Substring(pos+1, mangledName.Length - pos - 1) + NameArityPair(res, int32 num) + let DemangleGenericTypeName (mangledName: string) = match TryDemangleGenericNameAndPos mangledName with | 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/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs index 74f2be21d6f..4e9229b8df2 100644 --- a/src/fsharp/SyntaxTree.fs +++ b/src/fsharp/SyntaxTree.fs @@ -1868,7 +1868,7 @@ type SynMemberDefn = /// An 'open' definition within a type | Open of - longId: LongIdent * + target: SynOpenDeclTarget * range: range /// A 'member' definition within a type @@ -2000,7 +2000,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 @@ -2031,6 +2031,22 @@ type SynModuleDecl = | SynModuleDecl.NamespaceFragment (SynModuleOrNamespace (range=m)) | SynModuleDecl.Attributes (range=m) -> m +/// Represents the target of the open declaration +[] +type SynOpenDeclTarget = + + /// 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 [] type SynExceptionSig = @@ -2073,7 +2089,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 20b88579ea7..adba0794ac2 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -374,11 +374,19 @@ 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 -let OpenEntities tcSink g amap scopem root env mvvs openDeclaration = +/// Adjust the TcEnv to account for opening the set of modules or namespaces implied by an `open` declaration +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 + +/// 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 } CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) CallOpenDeclarationSink tcSink openDeclaration env @@ -648,11 +656,12 @@ 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) - OpenEntities tcSink g amap scopem false env modrefs openDecl + let openTarget = SynOpenDeclTarget.ModuleOrNamespace(enclosingNamespacePathToOpen, scopem) + let openDecl = OpenDeclaration.Create (openTarget, modrefs, [], scopem, true) + OpenModuleOrNamespaceRefs tcSink g amap scopem false env modrefs openDecl | Exception _ -> env | _ -> env @@ -892,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 @@ -3204,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 @@ -3643,16 +3652,19 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = // Mutually recursive shapes //------------------------------------------------------------------------- +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 [] -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 = @@ -3789,7 +3801,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() @@ -4248,21 +4260,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 @@ -4662,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 tcref = ForceRaise(ResolveTypeLongIdent 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)) @@ -4673,12 +4682,12 @@ 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 tinstEnclosing [] | SynType.App (StripParenTypes (SynType.LongIdent(LongIdentWithDots(tc, _))), _, args, _commas, _, postfix, m) -> let ad = env.eAccessRights - let tcref = + let tinstEnclosing, tcref = let tyResInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No |> ForceRaise @@ -4695,7 +4704,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 tinstEnclosing args | _, TyparKind.Measure -> match args, postfix with | [arg], true -> @@ -5129,12 +5138,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 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 = List.truncate (max (tinst.Length - tcref.Typars(mWholeTypeApp).Length) 0) tinst + | TType_app(tcref, _) -> TcTypeApp cenv newOk checkCxs occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -5425,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 @@ -5939,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) @@ -7367,7 +7375,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, _) :: _) -> @@ -9521,7 +9529,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 _ @@ -9541,10 +9549,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 | _ -> @@ -9557,7 +9565,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 | _ -> @@ -9674,7 +9682,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 @@ -9827,20 +9835,21 @@ 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' - 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) - 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 + 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) @@ -9912,7 +9921,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 tinstEnclosing tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_EXTENSIONTYPING @@ -9933,7 +9942,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 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]) @@ -10074,7 +10083,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 tinstEnclosing tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty @@ -10297,7 +10306,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 @@ -13208,12 +13217,12 @@ let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) = | [] -> [] | 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 + match ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.eNameResEnv ad id rest true with | Result res -> res | Exception err -> errorR(err); [] -let TcOpenDecl tcSink (g: TcGlobals) 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 -> @@ -13265,11 +13274,32 @@ 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 env = OpenEntities tcSink g amap scopem false env modrefs openDecl + let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.ModuleOrNamespace (longId, m), modrefs, [], scopem, false) + let env = OpenModuleOrNamespaceRefs tcSink g amap scopem false env modrefs openDecl env +let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) = + let g = cenv.g + + checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration mOpenDecl + + let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType + + if not (isAppTy g typ) then + error(Error(FSComp.SR.tcNamedTypeRequired("open type"), m)) + if isByrefTy g typ then + 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 + env + +let TcOpenDecl cenv mOpenDecl scopem env target = + match target with + | 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 /// Incremental class definitions @@ -14104,7 +14134,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 SynOpenDeclTarget * range #endif /// Indicates the super init has just been called, 'this' may now be published | Phase2AIncrClassCtorJustAfterSuperInit @@ -14116,7 +14146,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 = @@ -14135,7 +14165,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 = @@ -14149,7 +14179,7 @@ module MutRecBindingChecking = type TyconBindingsPhase2C = TyconBindingsPhase2C of Tycon option * TyconRef * TyconBindingPhase2C list - type MutRecDefnsPhase2CData = MutRecShape list + type MutRecDefnsPhase2CData = MutRecShape list @@ -14286,9 +14316,9 @@ module MutRecBindingChecking = cbinds, innerState #if OPEN_IN_TYPE_DECLARATIONS - | SynMemberDefn.Open (mp, m), _ -> + | SynMemberDefn.Open (target, m), _ -> let innerState = (incrClassCtorLhsOpt, env, tpenv, recBindIdx, prelimRecValuesRev, uncheckedBindsRev) - [ Phase2AOpen (mp, m) ], innerState + [ Phase2AOpen (target, m) ], innerState #endif | definition -> @@ -14500,9 +14530,9 @@ 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 + | Phase2AOpen(target, m) -> + 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 @@ -14747,7 +14777,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 @@ -14783,7 +14813,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 (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) @@ -14809,7 +14839,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 @@ -15523,12 +15553,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 | [] -> () @@ -15732,7 +15762,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), _) -> @@ -15962,7 +15992,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 -> @@ -16204,7 +16234,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) @@ -16881,7 +16911,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. @@ -17056,12 +17086,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 || @@ -17569,9 +17601,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) -> @@ -17619,7 +17651,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 @@ -17689,7 +17721,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 env ([p], m.EndRange) | None -> env // Publish the combined module type @@ -17734,9 +17766,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 (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) | SynModuleSigDecl.Exception (SynExceptionSig(exnRepr, members, _), _) -> @@ -17801,7 +17833,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 @@ -17863,9 +17895,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) -> @@ -17998,7 +18030,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 env ([p], m.EndRange) | None -> env // Publish the combined module type @@ -18065,9 +18097,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) -> @@ -18170,8 +18202,9 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env match modref.TryDeref with | ValueNone -> warn() | ValueSome _ -> - let openDecl = OpenDeclaration.Create ([], [modref], scopem, false) - OpenEntities TcResultsSink.NoSink g amap scopem root env [modref] openDecl + let openTarget = SynOpenDeclTarget.ModuleOrNamespace([], scopem) + let openDecl = OpenDeclaration.Create (openTarget, [modref], [], scopem, false) + 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) = diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index 49471c97d7e..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 TcOpenDecl : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> range -> TcEnv -> LongIdent -> TcEnv +val TcOpenModuleOrNamespaceDecl: NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> TcEnv -> (LongIdent * range) -> TcEnv type TopAttribs = { mainMethodAttrs : Attribs; 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'. diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 5182f06d056..e3b8e5a8eb5 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -9207,21 +9207,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 89fae6625e4..95203c2133e 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2379,8 +2379,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 diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 1d757e4789d..5eade4d6a12 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -330,7 +330,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 */ @@ -811,8 +810,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 + { 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 @@ -1305,9 +1304,16 @@ moduleDefn: [] } /* 'open' declarations */ - | openDecl - { [SynModuleDecl.Open($1, $1.Range)] } + | openDecl + { [ SynModuleDecl.Open($1, (rhs parseState 1)) ] } +openDecl: + /* 'open' declarations */ + | OPEN path + { SynOpenDeclTarget.ModuleOrNamespace($2.Lid, (rhs parseState 2)) } + + | OPEN typeKeyword appType + { 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) */ @@ -2505,9 +2511,6 @@ exconRepr: | EQUALS path { Some ($2.Lid) } -openDecl: - | OPEN path { $2 } - /*-------------------------------------------------------------------------*/ /* F# Definitions, Types, Patterns and Expressions */ diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 8de2a871d52..5390127d405 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.Types _ when isOpenType -> true | _ -> false), denv, m) // Completion at '(x: ...)" @@ -1954,7 +1954,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/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index afd85d7db29..0fb348c3e86 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -69,7 +69,8 @@ module TcResolutionsExtensions = | ItemOccurence.UseInAttribute | ItemOccurence.Use _ | ItemOccurence.Binding _ - | ItemOccurence.Pattern _ -> Some() + | ItemOccurence.Pattern _ + | ItemOccurence.Open -> Some() | _ -> None let (|KeywordIntrinsicValue|_|) (vref: ValRef) = diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index 2d5d1729d97..500b93c22ab 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(_target, _range) -> None | SynModuleDecl.Attributes(_synAttributes, _range) -> None | SynModuleDecl.HashDirective(_parsedHashDirective, range) -> visitor.VisitHashDirective range | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index 02054ef540a..c8d14e6af18 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 @@ -1331,7 +1331,7 @@ module UntypedParseImpl = member __.VisitModuleDecl(defaultTraverse, decl) = match decl with - | SynModuleDecl.Open(_, 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 @@ -1339,8 +1339,12 @@ 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 - Some CompletionContext.OpenDeclaration + if rangeContainsPos m pos then + let isOpenType = + match target with + | SynOpenDeclTarget.Type _ -> true + | SynOpenDeclTarget.ModuleOrNamespace _ -> false + 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/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index f387a9bc7e1..4fe8986ec97 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.ModuleOrNamespace(longId, _) -> longId + | SynOpenDeclTarget.Type(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..1e088f3994d 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 members and nested types is opened with this declaration. + member Types: FSharpType list + /// Scope in which open declaration is visible. member AppliedScope: range diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index 85c5a1dd685..d5234daa886 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -117,9 +117,9 @@ nepovinný zprostředkovatel komunikace s možnou hodnotou null - - open static classes - otevřít statické třídy + + open type declaration + open type declaration @@ -297,6 +297,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. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index 4343505305c..712e72c705a 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -117,9 +117,9 @@ Interop, NULL-Werte zulassend, optional - - open static classes - geöffnete statische Klassen + + open type declaration + open type declaration @@ -297,6 +297,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. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 7b1c9bc3619..a18fbfc2031 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -117,9 +117,9 @@ interoperabilidad opcional que admite valores NULL - - open static classes - abrir clases estáticas + + open type declaration + open type declaration @@ -297,6 +297,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. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 90c6a9d192a..b9e6943674a 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -117,9 +117,9 @@ interopérabilité facultative pouvant accepter une valeur null - - open static classes - ouvrir les classes statiques + + open type declaration + open type declaration @@ -297,6 +297,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. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 52d632c672d..a361bfb9667 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -117,9 +117,9 @@ Interop facoltativo nullable - - open static classes - classi statiche aperte + + open type declaration + open type declaration @@ -297,6 +297,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. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 866fbf177a3..5a898f407bc 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -117,9 +117,9 @@ Null 許容のオプションの相互運用 - - open static classes - 静的クラスを開く + + open type declaration + open type declaration @@ -297,6 +297,11 @@ 属性を型拡張に適用することはできません。 + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' @@ -7529,4 +7534,4 @@ - \ No newline at end of file + diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index 2efee94592f..e6dcc94dabb 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -117,9 +117,9 @@ nullable 선택적 interop - - open static classes - 정적 클래스 열기 + + open type declaration + open type declaration @@ -297,6 +297,11 @@ 형식 확장에 특성을 적용할 수 없습니다. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index 5af8aede353..2277b8409ec 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -117,9 +117,9 @@ opcjonalna międzyoperacyjność dopuszczająca wartość null - - open static classes - otwórz klasy statyczne + + open type declaration + open type declaration @@ -297,6 +297,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. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index f3113623c6d..042cc0e2a80 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -117,9 +117,9 @@ interoperabilidade opcional anulável - - open static classes - abrir classes estáticas + + open type declaration + open type declaration @@ -297,6 +297,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. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index 117a0e2c560..386ca343cf6 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -117,9 +117,9 @@ необязательное взаимодействие, допускающее значение NULL - - open static classes - открытые статические классы + + open type declaration + open type declaration @@ -297,6 +297,11 @@ Атрибуты не могут быть применены к расширениям типа. + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index 831467be110..c49a2a81be2 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -117,9 +117,9 @@ null atanabilir isteğe bağlı birlikte çalışma - - open static classes - açık statik sınıflar + + open type declaration + open type declaration @@ -297,6 +297,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. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index 03e0d217ac1..e65b266806a 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -117,9 +117,9 @@ 可以为 null 的可选互操作 - - open static classes - 打开静态类 + + open type declaration + open type declaration @@ -297,6 +297,11 @@ 属性不可应用于类型扩展。 + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index f00d5b8f9cc..2dc36ab91b0 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -117,9 +117,9 @@ 可為 Null 的選擇性 Interop - - open static classes - 開啟靜態類別 + + open type declaration + open type declaration @@ -297,6 +297,11 @@ 屬性無法套用到類型延伸模組。 + + Byref types are not allowed in an open type declaration. + Byref types are not allowed in an open type declaration. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index b8d4db8a79d..b9cd736b836 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -234,7 +234,7 @@ module rec Compiler = let private compileFSharpCompilation compilation ignoreWarnings : TestResult = - let ((err: FSharpErrorInfo[], outputFilePath: string), deps) = CompilerAssert.CompileRaw(compilation) + let ((err: FSharpErrorInfo[], outputFilePath: string), deps) = 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 fd48881c0c0..f4e221c811a 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -306,7 +306,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 @@ -386,10 +386,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 let executeBuiltAppAndReturnResult (outputFilePath: string) (deps: string list) : (int * string * string) = let out = Console.Out @@ -468,8 +468,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 ExecuteAndReturnResult (outputFilePath: string, deps: string list, newProcess: bool) = // If we execute in-process (true by default), then the only way of getting STDOUT is to redirect it to SB, and STDERR is from catching an exception. diff --git a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs index 791fd892132..0dc7b3a71e8 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 = "5.0" - #if NETCOREAPP [] module DefaultInterfaceMemberConsumptionTests_LanguageVersion_4_6 = + [] + let targetVersion = "5.0" + [] let ``IL - Errors with lang version not supported`` () = let ilSource = @@ -949,6 +946,9 @@ type Test2 () = [] module DefaultInterfaceMemberConsumptionTests_LanguageVersion_4_6_net472 = + [] + let targetVersion = "5.0" + [] let ``IL - Errors with lang version and target runtime not supported`` () = let ilSource = @@ -4957,6 +4957,9 @@ let f () = [] module DefaultInterfaceMemberConsumptionTests_net472 = + [] + let targetVersion = "5.0" + [] let ``IL - Errors with target runtime not supported`` () = let ilSource = diff --git a/tests/fsharp/Compiler/Language/OpenStaticClasses.fs b/tests/fsharp/Compiler/Language/OpenStaticClasses.fs deleted file mode 100644 index deff83a5c42..00000000000 --- a/tests/fsharp/Compiler/Language/OpenStaticClasses.fs +++ /dev/null @@ -1,189 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.UnitTests - -open FSharp.Compiler.SourceCodeServices -open NUnit.Framework -open FSharp.Test.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 OpenStaticClassesTests = - - let baseModule = """ -module Core_OpenStaticClasses - -[] -type MyMath() = - static member Min(a: double, b: double) = System.Math.Min(a, b) - static member Min(a: int, b: int) = System.Math.Min(a, b) - -[] -type AutoOpenMyMath() = - static member AutoMin(a: double, b: double) = System.Math.Min(a, b) - static member AutoMin(a: int, b: int) = System.Math.Min(a, b) - -[] -type NotAllowedToOpen() = - static member QualifiedMin(a: double, b: double) = System.Math.Min(a, b) - static member QualifiedMin(a: int, b: int) = System.Math.Min(a, b) - -""" - - [] - let ``OpenStaticClassesTests - OpenSystemMathOnce - langversion:v4.6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ -module OpenSystemMathOnce = - - open System.Math - let x = Min(1.0, 2.0)""") - [| - (FSharpErrorSeverity.Error, 39, (22,28,22,32), "The namespace 'Math' is not defined."); - (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 ``OpenStaticClassesTests - OpenSystemMathOnce - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ -module OpenSystemMathOnce = - - open System.Math - let x = Min(1.0, 2.0)""") - [| |] - - [] - let ``OpenStaticClassesTests - OpenSystemMathTwice - langversion:v4.6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ -module OpenSystemMathTwice = - - open System.Math - let x = Min(1.0, 2.0) - - open System.Math - let x2 = Min(2.0, 1.0)""") - [| - (FSharpErrorSeverity.Error, 39, (22,17,22,21), "The namespace 'Math' is not defined."); - (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, 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") - |] - - [] - let ``OpenStaticClassesTests - OpenSystemMathTwice - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ -module OpenSystemMathOnce = - - open System.Math - let x = Min(1.0, 2.0)""") - [| |] - - [] - let ``OpenStaticClassesTests - OpenMyMathOnce - langversion:v4.6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ -module OpenMyMathOnce = - - open MyMath - 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, 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") - |] - - [] - let ``OpenStaticClassesTests - OpenMyMathOnce - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ -module OpenMyMathOnce = - - open MyMath - let x = Min(1.0, 2.0) - let x2 = Min(1, 2)""") - [| |] - - [] - let ``OpenStaticClassesTests - DontOpenAutoMath - langversion:v4.6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (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.") - |] - - [] - let ``OpenStaticClassesTests - DontOpenAutoMath - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ -module DontOpenAutoMath = - - let x = AutoMin(1.0, 2.0) - let x2 = AutoMin(1, 2)""") - [| |] - - [] - let ``OpenStaticClassesTests - OpenAutoMath - langversion:v4.6`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:4.6" |] - (baseModule + """ -module OpenAutoMath = - open AutoOpenMyMath - //open NotAllowedToOpen - - 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, 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.") - |] - - [] - let ``OpenStaticClassesTests - OpenAutoMath - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ -module OpenAutoMath = - open AutoOpenMyMath - //open NotAllowedToOpen - - let x = AutoMin(1.0, 2.0) - let x2 = AutoMin(1, 2)""") - [| |] - - [] - let ``OpenStaticClassesTests - OpenAccessibleFields - langversion:preview`` () = - CompilerAssert.TypeCheckWithErrorsAndOptions - [| "--langversion:preview" |] - (baseModule + """ -module OpenAFieldFromMath = - open System.Math - - let pi = PI""") - [||] - - // TODO - wait for Will's integration of testing changes that makes this easlier - // [] - // let ``OpenStaticClassesTests - InternalsVisibleWhenHavingAnIVT - langversion:preview``() = ... diff --git a/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs new file mode 100644 index 00000000000..7bde3781e72 --- /dev/null +++ b/tests/fsharp/Compiler/Language/OpenTypeDeclarationTests.fs @@ -0,0 +1,2396 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open FSharp.Compiler.SourceCodeServices +open NUnit.Framework +open FSharp.Test.Utilities +open FSharp.Test.Utilities.Utilities +open FSharp.Test.Utilities.Compiler +open FSharp.Tests + +[] +module OpenTypeDeclarationTests = + + [] + let targetVersion = "'preview'" + + let baseModule = """ +module Core_OpenStaticClasses + +[] +type MyMath() = + static member Min(a: double, b: double) = System.Math.Min(a, b) + static member Min(a: int, b: int) = System.Math.Min(a, b) + +[] +type AutoOpenMyMath() = + static member AutoMin(a: double, b: double) = System.Math.Min(a, b) + static member AutoMin(a: int, b: int) = System.Math.Min(a, b) + +[] +type NotAllowedToOpen() = + static member QualifiedMin(a: double, b: double) = System.Math.Min(a, b) + static member QualifiedMin(a: int, b: int) = System.Math.Min(a, b) + +""" + + [] + let ``OpenSystemMathOnce - langversion:v4_6`` () = + Fsx (baseModule + """ +module OpenSystemMathOnce = + + open type System.Math + 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`` () = + 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`` () = + Fsx (baseModule + """ +module OpenSystemMathTwice = + + open type System.Math + let x = Min(1.0, 2.0) + + open type System.Math + let x2 = Min(2.0, 1.0)""") + |> 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`` () = + 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`` () = + Fsx (baseModule + """ +module OpenMyMathOnce = + + open type MyMath + let x = Min(1.0, 2.0) + let x2 = Min(1, 2)""") + |> 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`` () = + 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`` () = + Fsx (baseModule + """ +module DontOpenAutoMath = + + let x = AutoMin(1.0, 2.0) + let x2 = AutoMin(1, 2)""") + |> 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`` () = + 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`` () = + Fsx (baseModule + """ +module OpenAutoMath = + open type AutoOpenMyMath + //open type NotAllowedToOpen + + let x = AutoMin(1.0, 2.0) + let x2 = AutoMin(1, 2)""") + |> 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`` () = + 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`` () = + 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`` () = + let csharp = + CSharp """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public void A() + { + } + } + + public class NestedTest + { + public void B() + { + } + } + } +}""" + + FSharp """ +namespace FSharpTest + +open type CSharpTest.Test + +module Test = + let x = NestedTest() + let y = NestedTest() + let a = x.A() + 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 csharp = + CSharp """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public void A() + { + } + } + + public class NestedTest + { + public void B() + { + } + } + } +}""" + + FSharp """ +namespace FSharpTest + +open System +type Abbrev = CSharpTest.Test +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 csharp = + CSharp """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public void A() + { + } + } + + public class NestedTest + { + public void B() + { + } + } + } +}""" + + FSharp """ +namespace FSharpTest + +open System +type Abbrev = CSharpTest.Test +open type Abbrev""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Open a nested type as qualified`` () = + let csharp = + CSharp """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public class NestedTest + { + public static void A() + { + } + } + } +}""" + + FSharp """ +namespace FSharpTest + +open System +open type CSharpTest.Test.NestedTest + +module Test = + let x = A()""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Open generic type and use nested types as unqualified`` () = + let csharp = + CSharp """ +namespace CSharpTest +{ + public class Test + { + public class NestedTest + { + public T B() + { + return default(T); + } + } + + public class NestedTest + { + public T A() + { + return default(T); + } + } + } + + public class Test + { + } +}""" + + FSharp """ +namespace FSharpTest + +open System + +module Test = + + 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 : byte = x.B() + + let y = NestedTest() + let ya : byte = y.A() + + let x1 = new NestedTest() + 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()""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Open generic type and use nested types as unqualified 2`` () = + FSharp """ +namespace FSharpTest + +open type System.Collections.Generic.List + +module Test = + let e2 = new Enumerator()""" + |> withOptions ["--langversion:preview"] + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Open generic type and use nested types as unqualified 3`` () = + let csharp = + CSharp """ +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); + } + } + } + } +}""" + + FSharp """ +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 = 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 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 : NestedNestedTest = NestedNestedTest() + let dd : int = d.D()""" + |> withOptions ["--langversion:preview"] + |> withReferences [csharp] + |> compile + |> 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 ``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 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 """ +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 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. + // 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 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. + // 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 ``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 + let y = EnumCase2 + """ + |> withOptions ["--langversion:preview"] + |> compile + |> 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 access to union cases`` () = + 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 + |> 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 """ +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 + |> 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 """ +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 ``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 = + CSharp """ +using System; + +namespace CSharpTest +{ + public static class Test + { + public static void A() + { + } + } +} + """ + + FSharp """ +namespace FSharpTest + +open System +open CSharpTest.Test + +module Test = + 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`` () = + FSharp """ +namespace FSharpTest + +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`` () = + FSharp """ +namespace FSharpTest + +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`` () = + FSharp """ +namespace FSharpTest + +open type byref +open type inref +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`` () = + 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 ``Opened types do no allow unqualified access to their inherited type's members - Error`` () = + Fsx """ +open type System.Math + +let x = Equals(2.0, 3.0) + """ + |> 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`` () = + FSharp """ +open System.Runtime.CompilerServices + +module TestExtensions = + [] + type IntExtensions = + + [] + static member Test(_: int) = () + +open type TestExtensions.IntExtensions + +[] +let main _ = + Test(1) + 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`` () = + FSharp """ +open System.Runtime.CompilerServices + +module TestExtensions = + type IntExtensions = + + [] + static member Test(_: int) = () + +open type TestExtensions.IntExtensions + +[] +let main _ = + Test(1) + 0""" + |> withOptions ["--langversion:preview"] + |> asExe + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Opened types do allow unqualified access to members with no [] attribute`` () = + FSharp """ +open System.Runtime.CompilerServices + +module TestExtensions = + [] + type IntExtensions = + + static member Test(_: int) = () + +open type TestExtensions.IntExtensions + +[] +let main _ = + Test(1) + 0""" + |> withOptions ["--langversion:preview"] + |> asExe + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Opened types with C# style extension members are available for normal extension method lookup`` () = + FSharp """ +open System.Runtime.CompilerServices + +module TestExtensions = + [] + type IntExtensions = + + [] + static member Test(_: int) = () + +open type TestExtensions.IntExtensions + +[] +let main _ = + let x = 1 + x.Test() + 0""" + |> withOptions ["--langversion:preview"] + |> asExe + |> compile + |> 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 = + """ +.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 + +type C with + + member _.X = obj () + +type C with + + member _.X() = obj () + +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 + +type C with + + member _.X = obj () + +type C with + + member _.X() = obj () + +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 a 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 +{ + .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 + + .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 +{ + .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 + + .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() + } + + .method public hidebysig static + float32 X () cil managed + { + .maxstack 8 + + IL_0000: ldc.r4 0.0 + IL_0005: ret + } +} + """ + + let fsharpSource = + """ +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() + """ + + let ilCmpl = + CompilationUtil.CreateILCompilation ilSource + |> CompilationReference.Create + + let fsCmpl = + Compilation.Create(fsharpSource, Fs, Library, options = [|"--langversion:preview"|], cmplRefs = [ilCmpl]) + + CompilerAssert.Compile(fsCmpl) + +#if NETCOREAPP + + [] + let ``Opening an interface with a static method`` () = + let csharpSource = + """ +using System; + +namespace CSharpTest +{ + public interface ITest + { + public static void M() + { + } + } +} + """ + + let fsharpSource = + """ +open System +open CSharpTest + +open type ITest + +[] +let main _ = + M() + 0 + """ + + let csCmpl = + CompilationUtil.CreateCSharpCompilation(csharpSource, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp31) + |> CompilationReference.Create + + let fsCmpl = + 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.NetCoreApp31) + |> 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.NetCoreApp31) + |> 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.") + |]) + +#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 diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 3e1c1918e72..92621a41a77 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -54,7 +54,7 @@ - + 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 diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index f03127bb8a7..90328a73d8f 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(longIdentWithDots, range) -> [ identAndRange (longIdentWithDotsToString longIdentWithDots) 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 diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 110db85e4f5..7068cd4736d 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) ] 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``() = diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 520ef2b661c..4f7c5f3ae68 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -486,7 +486,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, []) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index c64e4026954..d7ee09bf479 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 @" @@ -3909,8 +3902,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``() = @@ -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``() =