Fixes #14613

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

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 

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 =

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
 

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

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
 

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")
-        ]
+        ]
+
+    [<Fact>]
+    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
+
+    [<Fact>]
+    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
+
+
+    [<Fact>]
+    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
+
+
+    [<Fact>]
+    let ``Disallow implementing more than one abstract slot`` () =
+        let app = FSharp """
+module ClassTests
+
+[<AbstractClass>]
+type PA() =
+    abstract M : int -> unit
+
+[<AbstractClass>]
+type PB<'a>() =
+    inherit PA()
+    abstract M : 'a -> unit
+[<AbstractClass>]
+type PC() =
+    inherit PB<int>()
+    // Here, PA.M and PB<int>.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'")
+
+    [<Fact>]
+    let ``Generic overrides work with preview version`` () =
+        let CSLib =
+            CSharp """
+public class C
+{
+    public virtual void M<T1, T2, T3>(T1? a, T2 b, T1? c, T3? d) {}
+}
+
+public class D : C
+{
+    public override void M<T1, T2, T3>(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