diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index d5c2087765e..dca26a94e3f 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -17,6 +17,7 @@ * Fix `YieldFromFinal`/`ReturnFromFinal` being incorrectly called in non-tail positions (`for`, `use`, `use!`, `try/with` handler). ([Issue #19402](https://github.com/dotnet/fsharp/issues/19402), [PR #19403](https://github.com/dotnet/fsharp/pull/19403)) * Fixed how the source ranges of warn directives are reported (as trivia) in the parser output (by not reporting leading spaces). ([Issue #19405](https://github.com/dotnet/fsharp/issues/19405), [PR #19408]((https://github.com/dotnet/fsharp/pull/19408))) * Fix UoM value type `ToString()` returning garbage values when `--checknulls+` is enabled, caused by double address-taking in codegen. ([Issue #19435](https://github.com/dotnet/fsharp/issues/19435), [PR #19440](https://github.com/dotnet/fsharp/pull/19440)) +* Fix accessibility and type-matching for CE and 'use' extension method lookups. ([Issue #19349](https://github.com/dotnet/fsharp/issues/19349), [PR #19536](https://github.com/dotnet/fsharp/pull/19536)) ### Added diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 0899ff2d09f..fad2b2d6683 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -67,6 +67,7 @@ let inline noTailCall ceenv = { ceenv with tailCall = false } let inline TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty = AllMethInfosOfTypeInScope collectionSettings cenv.infoReader env.NameEnv (Some nm) ad IgnoreOverrides m ty + |> List.filter (IsExtensionMethCompatibleWithTy cenv.g cenv.amap m ty) /// Ignores an attribute let inline IgnoreAttribute _ = None diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 635a0dff045..6f17d660668 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -3121,6 +3121,7 @@ let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo let TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty = AllMethInfosOfTypeInScope collectionSettings cenv.infoReader env.NameEnv (Some nm) ad IgnoreOverrides m ty + |> List.filter (IsExtensionMethCompatibleWithTy cenv.g cenv.amap m ty) let TryFindFSharpSignatureInstanceGetterProperty (cenv: cenv) (env: TcEnv) m nm ty (sigTys: TType list) = let g = cenv.g diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 55ab3c9219b..c01420ad633 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -727,8 +727,11 @@ let SelectMethInfosFromExtMembers (infoReader: InfoReader) optFilter apparentTy ] /// Query the available extension methods of a type (including extension methods for inherited types) -let ExtensionMethInfosOfTypeInScope (collectionSettings: ResultCollectionSettings) (infoReader: InfoReader) (nenv: NameResolutionEnv) optFilter isInstanceFilter m ty = - let extMemsDangling = SelectMethInfosFromExtMembers infoReader optFilter ty m nenv.eUnindexedExtensionMembers +let ExtensionMethInfosOfTypeInScope (collectionSettings: ResultCollectionSettings) (infoReader: InfoReader) (nenv: NameResolutionEnv) ad optFilter isInstanceFilter m ty = + let amap = infoReader.amap + + let extMemsDangling = SelectMethInfosFromExtMembers infoReader optFilter ty m nenv.eUnindexedExtensionMembers + if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then extMemsDangling else @@ -743,6 +746,9 @@ let ExtensionMethInfosOfTypeInScope (collectionSettings: ResultCollectionSetting | _ -> []) extMemsDangling @ extMemsFromHierarchy |> List.filter (fun minfo -> + let isAccesible = AccessibilityLogic.IsMethInfoAccessible amap m ad minfo + + isAccesible && match isInstanceFilter with | LookupIsInstance.Ambivalent -> true | LookupIsInstance.Yes -> minfo.IsInstance @@ -754,7 +760,27 @@ let AllMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad fi if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil intrinsic) then intrinsic else - intrinsic @ ExtensionMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter LookupIsInstance.Ambivalent m ty + intrinsic @ ExtensionMethInfosOfTypeInScope collectionSettings infoReader nenv ad optFilter LookupIsInstance.Ambivalent m ty + +let IsExtensionMethCompatibleWithTy g amap m (ty: TType) (minfo: MethInfo) = + not minfo.IsExtensionMember || + match minfo.GetObjArgTypes(amap, m, []) with + | thisTy :: _ -> + let ty1 = thisTy |> stripTyEqns g + let ty2 = ty |> stripTyEqns g + + match ty1, ty2 with + | TType_var (tp1, _), _ -> + tp1.Constraints |> List.exists (function + | TyparConstraint.CoercesTo(targetCTy, _) -> + let cTy = targetCTy |> stripTyEqns g + TypeRelations.TypeFeasiblySubsumesType 0 g amap m cTy TypeRelations.CanCoerce ty2 + | _ -> false) + | _, TType_var _ -> true + | _ -> + TypeRelations.TypeFeasiblySubsumesType 0 g amap m ty1 TypeRelations.CanCoerce ty2 + | _ -> + true //------------------------------------------------------------------------- // Helpers to do with building environments @@ -1184,7 +1210,7 @@ let rec AddStaticContentOfTypeToNameEnv (g:TcGlobals) (amap: Import.ImportMap) a [| // Extension methods yield! - ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None LookupIsInstance.No m ty + ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv ad None LookupIsInstance.No m ty |> ChooseMethInfosForNameEnv g m ty // Extension properties @@ -2827,7 +2853,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | _ -> // lookup in-scope extension methods // to keep in sync with the same expression in `| Some(MethodItem msets) when isLookupExpr` below - match ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv optFilter isInstanceFilter m ty with + match ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv ad optFilter isInstanceFilter m ty with | [] -> success [resInfo, x, rest] | methods -> let extensionMethods = Item.MakeMethGroup(nm, methods) @@ -2841,7 +2867,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf let minfos = msets |> ExcludeHiddenOfMethInfos g ncenv.amap m // fold the available extension members into the overload resolution - let extensionMethInfos = ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv optFilter isInstanceFilter m ty + let extensionMethInfos = ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv ad optFilter isInstanceFilter m ty success [resInfo, Item.MakeMethGroup (nm, minfos@extensionMethInfos), rest] @@ -2860,7 +2886,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf if not (isNil pinfos) && isLookUpExpr then OneResult(success (resInfo, Item.Property (nm, pinfos, None), rest)) else - let minfos = ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv optFilter isInstanceFilter m ty + let minfos = ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv ad optFilter isInstanceFilter m ty if not (isNil minfos) && isLookUpExpr then success [resInfo, Item.MakeMethGroup (nm, minfos), rest] @@ -2898,7 +2924,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf for p in ExtensionPropInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv None LookupIsInstance.Ambivalent ad m ty do addToBuffer p.PropertyName - for m in ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv None LookupIsInstance.Ambivalent m ty do + for m in ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv ad None LookupIsInstance.Ambivalent m ty do addToBuffer m.DisplayName for p in GetIntrinsicPropInfosOfType ncenv.InfoReader None ad AllowMultiIntfInstantiations.No findFlag m ty do diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index b5f6a7172aa..ecadc7430de 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -689,6 +689,15 @@ val internal AllMethInfosOfTypeInScope: ty: TType -> MethInfo list +/// Check whether the 'this' argument of an extension method is compatible with the target type +val internal IsExtensionMethCompatibleWithTy: + g: TcGlobals -> + amap: ImportMap -> + m: range -> + ty: TType -> + minfo: MethInfo -> + bool + /// Used to report an error condition where name resolution failed due to an indeterminate type exception internal IndeterminateType of range diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/UseBindings/UseBindingsAndExtensionMembers.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/UseBindings/UseBindingsAndExtensionMembers.fs new file mode 100644 index 00000000000..97315ef4cdc --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/UseBindings/UseBindingsAndExtensionMembers.fs @@ -0,0 +1,32 @@ +module Conformance.BasicGrammarElements.UseBindExtensionMethodCapture + +open Xunit +open FSharp.Test.Compiler + +[] +let ``Use binding doesn't capture an extension method with generic type``() = + FSharp """ + open System + open System.Runtime.CompilerServices + + type FooClass() = class end + + type Disposable() = + interface IDisposable with + member _.Dispose() = () + + [] + type PublicExtensions = + [] + static member inline Dispose(this: #FooClass) = + this + + let foo() = + use a = new Disposable() + () + + foo() + """ + |> asExe + |> compile + |> shouldSucceed \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ComputationExpressions/CEExtensionMethodCapture.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ComputationExpressions/CEExtensionMethodCapture.fs new file mode 100644 index 00000000000..027b93933b7 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ComputationExpressions/CEExtensionMethodCapture.fs @@ -0,0 +1,136 @@ +module Conformance.Expressions.CEExtensionMethodCapture + +open Xunit +open FSharp.Test.Compiler + +[] +let ``CE doesn't capture an extension method beyond the access domain``() = + FSharp """ + open System.Runtime.CompilerServices + + type AsyncSeq<'T>(i: 'T) = + class + let l = [i] + member this.Data = l + end + + type AsyncSeqBuilder() = + member _.Yield(x: 'T) : AsyncSeq<'T> = + AsyncSeq(x) + + [] + type PrivateExtensions = + [] + static member inline private Run(this: AsyncSeqBuilder) = + this + + let asyncSeq = AsyncSeqBuilder() + + let xs : AsyncSeq = + asyncSeq { + yield 1 + } + """ + |> asExe + |> compile + |> shouldSucceed + +[] +let ``CE doesn't capture an extension method with generic type``() = + FSharp """ + open System.Runtime.CompilerServices + + type FooClass = class end + + type AsyncSeq<'T>(i: 'T) = + class + let l = [i] + member this.Data = l + end + + type AsyncSeqBuilder() = + member _.Yield(x: 'T) : AsyncSeq<'T> = + AsyncSeq(x) + + [] + type PublicExtensions = + [] + static member inline Run(this: #FooClass) = + this + + let asyncSeq = AsyncSeqBuilder() + + let xs : AsyncSeq = + asyncSeq { + yield 1 + } + """ + |> asExe + |> compile + |> shouldSucceed + +// Deliberately trigger an error to ensure that a method is captured +[] +let ``CE captures a public extension method and procudes an error due to invalid args``() = + FSharp """ + open System.Runtime.CompilerServices + + type AsyncSeq<'T>(i: 'T) = + class + let l = [i] + member this.Data = l + end + + type AsyncSeqBuilder() = + member _.Yield(x: 'T) : AsyncSeq<'T> = + AsyncSeq(x) + + [] + type PublicExtensions = + [] + static member inline Run(this: AsyncSeqBuilder, invalidArg: string) = + this + + let asyncSeq = AsyncSeqBuilder() + + let xs : AsyncSeq = + asyncSeq { + yield 1 + } + """ + |> asExe + |> compile + |> shouldFail + +// Deliberately trigger an error to ensure that a method is captured +[] +let ``CE captures a public extension method with valid generic constrainted type and procudes an error due to invalid args``() = + FSharp """ + open System.Runtime.CompilerServices + + type AsyncSeq<'T>(i: 'T) = + class + let l = [i] + member this.Data = l + end + + type AsyncSeqBuilder() = + member _.Yield(x: 'T) : AsyncSeq<'T> = + AsyncSeq(x) + + [] + type PublicExtensions = + [] + static member inline Run(this: #AsyncSeqBuilder, invalidArg: string) = + this + + let asyncSeq = AsyncSeqBuilder() + + let xs : AsyncSeq = + asyncSeq { + yield 1 + } + """ + |> asExe + |> compile + |> shouldFail diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index f5d1048408e..2f07460ca6a 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -76,6 +76,7 @@ + @@ -85,6 +86,7 @@ +