Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fixes #14613 #14617

Merged
merged 9 commits into from
Jan 19, 2023
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 5 additions & 18 deletions src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
vzarytovskii marked this conversation as resolved.
Show resolved Hide resolved
// 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
Expand Down
14 changes: 12 additions & 2 deletions src/Compiler/Checking/InfoReader.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -561,8 +564,15 @@ 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 filterDifiniteOverrides x = not (isDefiniteOverride x)
vzarytovskii marked this conversation as resolved.
Show resolved Hide resolved

match findFlag with
match findFlag with
| DiscardOnFirstNonOverride ->
items
|> List.map (List.filter filterDifiniteOverrides)
|> ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes nmf (fun 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
Expand All @@ -583,7 +593,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 (List.filter filterDifiniteOverrides)

// Remove any virtuals that are signature-equivalent to virtuals in subtypes, except for newslots
// That is, keep if it's
Expand Down
4 changes: 4 additions & 0 deletions src/Compiler/Checking/InfoReader.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/Checking/MethodOverrides.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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

Expand Down
3 changes: 2 additions & 1 deletion src/Compiler/Checking/MethodOverrides.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion src/Compiler/Checking/NameResolution.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -542,4 +542,31 @@ 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")
]
]

vzarytovskii marked this conversation as resolved.
Show resolved Hide resolved
[<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