diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 63dc5bcb595..4c1c47f53b0 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -10922,7 +10922,7 @@ and ComputeIsComplete enclosingDeclaredTypars declaredTypars ty = /// Determine if a uniquely-identified-abstract-slot exists for an override member (or interface member implementation) based on the information available /// at the syntactic definition of the member (i.e. prior to type inference). If so, we know the expected signature of the override, and the full slotsig /// it implements. Apply the inferred slotsig. -and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (baseValOpt: Val option) (argsAndRetTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, intfSlotTyOpt, valSynData, memberFlags: SynMemberFlags, attribs) = +and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (_: Val option) (argsAndRetTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, intfSlotTyOpt, valSynData, memberFlags: SynMemberFlags, attribs) = let g = cenv.g let ad = envinner.eAccessRights @@ -10951,7 +10951,10 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (baseValOpt: Val o match memberFlags.MemberKind with | SynMemberKind.Member -> let dispatchSlots, dispatchSlotsArityMatch = - GetAbstractMethInfosForSynMethodDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, valSynData, memberFlags) + if g.langVersion.SupportsFeature(LanguageFeature.ErrorForNonVirtualMembersOverrides) then + GetAbstractMethInfosForSynMethodDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, valSynData, memberFlags, DiscardOnFirstNonOverride) + else + GetAbstractMethInfosForSynMethodDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, valSynData, memberFlags,IgnoreOverrides) let uniqueAbstractMethSigs = match dispatchSlots with @@ -10969,22 +10972,6 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (baseValOpt: Val o | _ -> [] // check that method to override is sealed is located at CheckOverridesAreAllUsedOnce (typrelns.fs) // We hit this case when it is ambiguous which abstract method is being implemented. - if g.langVersion.SupportsFeature(LanguageFeature.ErrorForNonVirtualMembersOverrides) then - // Checks if the declaring type inherits from a base class and is not FSharpObjModelTy - // Raises an error if we try to override an non virtual member with the same name in both - match baseValOpt with - | Some ttype when not(isFSharpObjModelTy g ttype.Type) -> - match stripTyEqns g ttype.Type with - | TType_app(tyconRef, _, _) -> - let ilMethods = tyconRef.ILTyconRawMetadata.Methods.AsList() - let nameOpt = ilMethods |> List.tryFind(fun id -> id.Name = memberId.idText) - match nameOpt with - | Some name when not name.IsVirtual -> - errorR(Error(FSComp.SR.tcNoMemberFoundForOverride(), memberId.idRange)) - | _ -> () - | _ -> () - | _ -> () - // If we determined a unique member then utilize the type information from the slotsig let declaredTypars = match uniqueAbstractMethSigs with diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 27eb5c2547e..5a6b63722cc 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -311,6 +311,9 @@ type FindMemberFlag = | IgnoreOverrides /// Get overrides instead of abstract slots when measuring whether a class/interface implements all its required slots. | PreferOverrides + /// Similar to "IgnoreOverrides", but filters the items bottom-to-top, + /// and discards all when finds first non-virtual member which hides one above it in hirearchy. + | DiscardOnFirstNonOverride /// The input list is sorted from most-derived to least-derived type, so any System.Object methods /// are at the end of the list. Return a filtered list where prior/subsequent members matching by name and @@ -561,9 +564,17 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = /// Filter the overrides of methods or properties, either keeping the overrides or keeping the dispatch slots. static let FilterOverrides findFlag (isVirt:'a->bool, isNewSlot, isDefiniteOverride, isFinal, equivSigs, nmf:'a->string) items = let equivVirts x y = isVirt x && isVirt y && equivSigs x y + let filterDefiniteOverrides = List.filter(isDefiniteOverride >> not) - match findFlag with - | PreferOverrides -> + match findFlag with + | DiscardOnFirstNonOverride -> + items + |> List.map filterDefiniteOverrides + |> ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes nmf (fun newItem priorItem -> + equivSigs newItem priorItem && + isVirt newItem && not (isVirt priorItem) + ) + | PreferOverrides -> items // For each F#-declared override, get rid of any equivalent abstract member in the same type // This is because F# abstract members with default overrides give rise to two members with the @@ -583,7 +594,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = items // Remove any F#-declared overrides. These may occur in the same type as the abstract member (unlike with .NET metadata) // Include any 'newslot' declared methods. - |> List.map (List.filter (fun x -> not (isDefiniteOverride x))) + |> List.map filterDefiniteOverrides // Remove any virtuals that are signature-equivalent to virtuals in subtypes, except for newslots // That is, keep if it's diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index da24ec26d9e..2d6489e70c9 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -89,6 +89,10 @@ type FindMemberFlag = /// Get overrides instead of abstract slots when measuring whether a class/interface implements all its required slots. | PreferOverrides + /// Similar to "IgnoreOverrides", but filters the items bottom-to-top, + /// and discards all when finds first non-virtual member which hides one above it in hirearchy. + | DiscardOnFirstNonOverride + /// An InfoReader is an object to help us read and cache infos. /// We create one of these for each file we typecheck. type InfoReader = diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index e317772dac4..58aa619bf04 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -927,7 +927,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv /// Get the methods relevant to determining if a uniquely-identified-override exists based on the syntactic information /// at the member signature prior to type inference. This is used to pre-assign type information if it does -let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = +let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags, findFlag: FindMemberFlag) = let g = infoReader.g if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then @@ -939,7 +939,7 @@ let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: | _, Some(SlotImplSet(_, dispatchSlotsKeyed, _, _)) -> NameMultiMap.find memberName.idText dispatchSlotsKeyed |> List.map (fun reqdSlot -> reqdSlot.MethodInfo) | ty, None -> - GetIntrinsicMethInfosOfType infoReader (Some memberName.idText) ad AllowMultiIntfInstantiations.Yes IgnoreOverrides bindm ty + GetIntrinsicMethInfosOfType infoReader (Some memberName.idText) ad AllowMultiIntfInstantiations.Yes findFlag bindm ty let dispatchSlots = minfos |> List.filter (fun minfo -> minfo.IsDispatchSlot) let valReprSynArities = SynInfo.AritiesOfArgs valSynData diff --git a/src/Compiler/Checking/MethodOverrides.fsi b/src/Compiler/Checking/MethodOverrides.fsi index 1c671e6bdb5..d18a8cdc6f1 100644 --- a/src/Compiler/Checking/MethodOverrides.fsi +++ b/src/Compiler/Checking/MethodOverrides.fsi @@ -156,7 +156,8 @@ val GetAbstractMethInfosForSynMethodDecl: bindm: range * typToSearchForAbstractMembers: (TType * SlotImplSet option) * valSynData: SynValInfo * - memberFlags: SynMemberFlags -> + memberFlags: SynMemberFlags * + findFlag: FindMemberFlag -> MethInfo list * MethInfo list /// Get the properties relevant to determining if a uniquely-identified-override exists based on the syntactic information diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index c5ace8603a6..6bc0b3e73b7 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3868,7 +3868,8 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes match findFlag, item with | FindMemberFlag.PreferOverrides, _ | _, NonOverridable() -> item, itemRange, false - | FindMemberFlag.IgnoreOverrides, _ -> + | FindMemberFlag.IgnoreOverrides, _ + | FindMemberFlag.DiscardOnFirstNonOverride, _ -> let _, item, _, itemRange = resolveExpr FindMemberFlag.PreferOverrides item, itemRange, true diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs index eeb3ab1d371..52824cf7278 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs @@ -542,4 +542,148 @@ type C() = |> withDiagnostics [ (Error 855, Line 7, Col 19, Line 7, Col 21, "No abstract or interface member was found that corresponds to this override") (Error 855, Line 9, Col 19, Line 9, Col 21, "No abstract or interface member was found that corresponds to this override") - ] \ No newline at end of file + ] + + [] + let ``Virtual members were found with multiple types in hierarchy with different overloads langversionPreview`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1(string s) { } +} + +public class B : A +{ + public virtual void M1(int i) { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type C() = + inherit B () + override _.M1 (i: string) = () + override _.M1 (i: int) = () + """ |> withReferences [CSLib] + app + |> withLangVersionPreview + |> compile + |> shouldSucceed + + [] + let ``Virtual member was found with multiple types in hierarchy with different overloads langversionPreview`` () = + let CSLib = + CSharp """ +public class A +{ + public virtual void M1(string s) { } +} + +public class B : A +{ + public void M1(int i) { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type C() = + inherit B () + override _.M1 (i: string) = () + """ |> withReferences [CSLib] + app + |> withLangVersionPreview + |> compile + |> shouldSucceed + + + [] + let ``Virtual member was found among virtual and non-virtual overloads with lang preview`` () = + let CSLib = + CSharp """ +public class A +{ + public void M1(int i) { } + public virtual void M1(string s) { } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests + +type Over () = + inherit A () + + override _.M1 (s: string) = () + """ + + app + |> withReferences [CSLib] + |> withLangVersionPreview + |> compile + |> shouldSucceed + + + [] + let ``Disallow implementing more than one abstract slot`` () = + let app = FSharp """ +module ClassTests + +[] +type PA() = + abstract M : int -> unit + +[] +type PB<'a>() = + inherit PA() + abstract M : 'a -> unit +[] +type PC() = + inherit PB() + // Here, PA.M and PB.M have the same signature, so PA.M is unimplementable. + // REVIEW: in future we may give a friendly error at this point +type PD() = + inherit PC() + override this.M(x: int) = () + """ + app + |> withLangVersionPreview + |> compile + |> shouldFail + |> withSingleDiagnostic (Error 361, Line 19, Col 19, Line 19, Col 20, "The override 'M: int -> unit' implements more than one abstract slot, e.g. 'abstract PB.M: 'a -> unit' and 'abstract PA.M: int -> unit'") + + [] + let ``Generic overrides work with preview version`` () = + let CSLib = + CSharp """ +public class C +{ + public virtual void M(T1? a, T2 b, T1? c, T3? d) {} +} + +public class D : C +{ + public override void M(T1? a, T2 b, T1? c, T3? d) + where T1 : default + where T3 : default + { + base.M(a, b, c, d); + } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ClassTests +type X = + inherit C + override this.M(a, b, c, d) = () + """ |> withReferences [CSLib] + app + |> withLangVersionPreview + |> compile + |> shouldSucceed \ No newline at end of file