diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index a6379e74893..4922dce7632 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -1203,11 +1203,13 @@ module MutRecBindingChecking = if cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired) then tyconOpt |> Option.map (fun tycon -> - tryAddExtensionAttributeIfNotAlreadyPresent + tryAddExtensionAttributeIfNotAlreadyPresentForType + g (fun tryFindExtensionAttribute -> tycon.MembersOfFSharpTyconSorted |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) ) + envForTycon.eModuleOrNamespaceTypeAccumulator tycon ) else @@ -1437,7 +1439,25 @@ module MutRecBindingChecking = let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BMember rbind.RecBindingInfo.Index, innerState) - + + let tyconOpt = + if not(cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired)) then + tyconOpt + else + // We need to redo this check, which already happened in TcMutRecBindings_Phase2A_CreateRecursiveValuesAndCheckArgumentPatterns + // Because the environment is being reset in the case of recursive modules. + tyconOpt + |> Option.map (fun tycon -> + tryAddExtensionAttributeIfNotAlreadyPresentForType + g + (fun tryFindExtensionAttribute -> + tycon.MembersOfFSharpTyconSorted + |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) + ) + envForTycon.eModuleOrNamespaceTypeAccumulator + tycon + ) + let defnBs = MutRecShape.Tycon (TyconBindingsPhase2B(tyconOpt, tcref, defnBs)) let outerState = (tpenv, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable, envNonRec) defnBs, outerState) @@ -4528,16 +4548,20 @@ module TcDeclarations = |> List.map (function | MutRecShape.Tycon (Some tycon, bindings) -> let tycon = - tryAddExtensionAttributeIfNotAlreadyPresent + tryAddExtensionAttributeIfNotAlreadyPresentForType + g (fun tryFindExtensionAttribute -> tycon.MembersOfFSharpTyconSorted |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) ) + envFinal.eModuleOrNamespaceTypeAccumulator tycon + MutRecShape.Tycon (Some tycon, bindings) | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(moduleOrNamespaceType, entity), env), shapes) -> let entity = - tryAddExtensionAttributeIfNotAlreadyPresent + tryAddExtensionAttributeIfNotAlreadyPresentForModule + g (fun tryFindExtensionAttribute -> moduleOrNamespaceType.Value.AllValsAndMembers |> Seq.filter(fun v -> v.IsModuleBinding) @@ -4659,8 +4683,28 @@ module TcDeclarations = let envForTycon = AddDeclaredTypars CheckForDuplicateTypars declaredTyconTypars envForDecls let envForTycon = MakeInnerEnvForTyconRef envForTycon tcref (declKind = ExtrinsicExtensionBinding) - TcTyconMemberSpecs cenv envForTycon (TyconContainerInfo(innerParent, tcref, declaredTyconTypars, NoSafeInitInfo)) declKind tpenv members) + let vals, env = TcTyconMemberSpecs cenv envForTycon (TyconContainerInfo(innerParent, tcref, declaredTyconTypars, NoSafeInitInfo)) declKind tpenv members + if not(cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired)) then + vals, env + else + // Check if any of the vals has the `[]` attribute + // If this is the case, add it to the type in the env. + let extensionAttributeOnVals = + vals + |> List.tryPick (fun v -> tryFindExtensionAttribute g v.Attribs) + + let typeEntity = + envForTycon.eModuleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(tcref.LogicalName) + match extensionAttributeOnVals, typeEntity with + | Some extensionAttribute, Some typeEntity -> + if Option.isNone (tryFindExtensionAttribute g typeEntity.Attribs) then + typeEntity.entity_attribs <- extensionAttribute :: typeEntity.Attribs + | _ -> () + + vals, env + + ) // Do this for each 'val' declaration in a module (fun envForDecls (containerInfo, valSpec) -> let tpenv = emptyUnscopedTyparEnv @@ -5130,7 +5174,8 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // //[] //let PlusOne (a:int) = a + 1 - tryAddExtensionAttributeIfNotAlreadyPresent + tryAddExtensionAttributeIfNotAlreadyPresentForModule + g (fun tryFindExtensionAttribute -> match moduleContents with | ModuleOrNamespaceContents.TMDefs(defs) -> diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 221e094fc9b..76e730eab6c 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10591,23 +10591,42 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC None | _ -> None -let tryAddExtensionAttributeIfNotAlreadyPresent +let tryFindExtensionAttribute (g: TcGlobals) (attribs: Attrib list): Attrib option = + attribs + |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_ExtensionAttribute) + +let tryAddExtensionAttributeIfNotAlreadyPresentForModule + (g: TcGlobals) + (tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option) + (moduleEntity: Entity) + : Entity + = + if Option.isSome (tryFindExtensionAttribute g moduleEntity.Attribs) then + moduleEntity + else + match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with + | None -> moduleEntity + | Some extensionAttrib -> + { moduleEntity with entity_attribs = extensionAttrib :: moduleEntity.Attribs } + +let tryAddExtensionAttributeIfNotAlreadyPresentForType + (g: TcGlobals) (tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option) - (entity: Entity) + (moduleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref) + (typeEntity: Entity) : Entity = - let tryFindExtensionAttribute (attribs: Attrib list): Attrib option = - List.tryFind - (fun (a: Attrib) -> - a.TyconRef.CompiledRepresentationForNamedType.BasicQualifiedName = "System.Runtime.CompilerServices.ExtensionAttribute") - attribs - - if Option.isSome (tryFindExtensionAttribute entity.Attribs) then - entity + if Option.isSome (tryFindExtensionAttribute g typeEntity.Attribs) then + typeEntity else - match tryFindExtensionAttributeIn tryFindExtensionAttribute with - | None -> entity - | Some extensionAttrib -> { entity with entity_attribs = extensionAttrib :: entity.Attribs } + match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with + | None -> typeEntity + | Some extensionAttrib -> + moduleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(typeEntity.LogicalName) + |> Option.iter (fun e -> + e.entity_attribs <- extensionAttrib :: e.Attribs + ) + typeEntity type TypedTreeNode = { diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index ce48b8894a6..2345ac5eb40 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2727,9 +2727,22 @@ type TraitConstraintInfo with val (|EmptyModuleOrNamespaces|_|): moduleOrNamespaceContents: ModuleOrNamespaceContents -> (ModuleOrNamespace list) option -/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the Entity if found via predicate and not already present. -val tryAddExtensionAttributeIfNotAlreadyPresent: - tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> entity: Entity -> Entity +val tryFindExtensionAttribute: g: TcGlobals -> attribs: Attrib list -> Attrib option + +/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the module Entity if found via predicate and not already present. +val tryAddExtensionAttributeIfNotAlreadyPresentForModule: + g: TcGlobals -> + tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> + moduleEntity: Entity -> + Entity + +/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the type Entity if found via predicate and not already present. +val tryAddExtensionAttributeIfNotAlreadyPresentForType: + g: TcGlobals -> + tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> + moduleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref -> + typeEntity: Entity -> + Entity /// Serialize an entity to a very basic json structure. val serializeEntity: path: string -> entity: Entity -> unit diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs index 510ac830ae4..60f902e9ef5 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs @@ -648,3 +648,40 @@ module M = |> withReferences [ csharp ] fsharp |> compile |> shouldSucceed + + [] + let ``F# CSharpStyleExtensionMethod consumed in F#`` () = + let producer = + FSharp + """ +namespace Producer + +open System.Runtime.CompilerServices + +type WidgetBuilder<'msg, 'marker>() = class end + +type IMarkerOne = interface end + +// Commenting out [] breaks +//[] +type WidgetBuilderExtensions = + [] + static member inline one(this: WidgetBuilder<'msg, #IMarkerOne>) = this +""" + |> withLangVersion80 + |> withName "FSLibProducer" + + let fsharp2 = + FSharp + """ +namespace Consumer + +open Producer + +module FSLibConsumer = + let x = WidgetBuilder().one() +""" + |> withName "FSLibConsumer" + |> withReferences [ producer ] + + fsharp2 |> compile |> shouldSucceed