Fix internal error when implementing IWSAM in object expression

src/Compiler/Checking/CheckExpressions.fs

@@ -6813,6 +6813,12 @@ and TcObjectExprBinding (cenv: cenv) (env: TcEnv) implTy tpenv (absSlotInfo, bin
                 let logicalMethId = id
                 let memberFlags = OverrideMemberFlags SynMemberKind.Member
                 bindingRhs, logicalMethId, memberFlags
+
+            | SynPat.Named (SynIdent(id,_), _, _, _), Some memberFlags ->
+                CheckMemberFlags None NewSlotsOK OverridesOK memberFlags mBinding
+                let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar (ident (CompilerGeneratedName "this", id.idRange))) bindingRhs
+                let logicalMethId = id
+                bindingRhs, logicalMethId, memberFlags
 
             | SynPat.InstanceMember(thisId, memberId, _, _, _), Some memberFlags ->
                 CheckMemberFlags None NewSlotsOK OverridesOK memberFlags mBinding
@@ -7018,17 +7024,17 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
 
             DispatchSlotChecking.CheckOverridesAreAllUsedOnce (env.DisplayEnv, g, cenv.infoReader, true, implTy, dispatchSlotsKeyed, availPriorOverrides, overrideSpecs)
 
-            DispatchSlotChecking.CheckDispatchSlotsAreImplemented (env.DisplayEnv, cenv.infoReader, m, env.NameEnv, cenv.tcSink, false, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore)
+            DispatchSlotChecking.CheckDispatchSlotsAreImplemented (env.DisplayEnv, cenv.infoReader, m, env.NameEnv, cenv.tcSink, false, true, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore)
 
         // 3. create the specs of overrides
         let allTypeImpls =
           overridesAndVirts |> List.map (fun (m, implTy, _, dispatchSlotsKeyed, _, overrides) ->
               let overrides' =
                   [ for overrideMeth in overrides do
                         let overrideInfo, (_, thisVal, methodVars, bindingAttribs, bindingBody) = overrideMeth
-                        let (Override(_, _, id, mtps, _, _, _, isFakeEventProperty, _, _)) = overrideInfo
+                        let (Override(_, _, id, mtps, _, _, _, isFakeEventProperty, _, isInstance)) = overrideInfo
 
-                        if not isFakeEventProperty then
+                        if not isFakeEventProperty && isInstance then
                             let searchForOverride =
                                 dispatchSlotsKeyed
                                 |> NameMultiMap.find id.idText
@@ -11249,7 +11255,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (_: Val option) (a
                      if instanceExpected then
                         errorR(Error(FSComp.SR.tcNoMemberFoundForOverride(), memberId.idRange))
                      else
-                        errorR (Error(FSComp.SR.tcNoStaticMemberFoundForOverride (), memberId.idRange))
+                        errorR(Error(FSComp.SR.tcNoStaticMemberFoundForOverride (), memberId.idRange))
                      []
 
                  | slot :: _ as slots ->

src/Compiler/Checking/MethodOverrides.fs

@@ -324,14 +324,15 @@ module DispatchSlotChecking =
     let CheckDispatchSlotsAreImplemented (denv, infoReader: InfoReader, m,
                                           nenv, sink: TcResultsSink,
                                           isOverallTyAbstract,
+                                          isObjExpr: bool,
                                           reqdTy,
                                           dispatchSlots: RequiredSlot list,
                                           availPriorOverrides: OverrideInfo list,
                                           overrides: OverrideInfo list) =
         let g = infoReader.g
         let amap = infoReader.amap
 
-        let isReqdTyInterface = isInterfaceTy g reqdTy 
+        let isReqdTyInterface = isInterfaceTy g reqdTy
         let showMissingMethodsAndRaiseErrors = (isReqdTyInterface || not isOverallTyAbstract)
 
         let mutable res = true
@@ -392,7 +393,7 @@ module DispatchSlotChecking =
                             noimpl()
                         | [ overrideBy ] ->
 
-                            let (Override(_, _, _, methTypars, _, argTys, _, _, _, _)) = overrideBy
+                            let (Override(_, _, _, methTypars, _, argTys, _, _, _, isInstance)) = overrideBy
 
                             let moreThanOnePossibleDispatchSlot =
                                 dispatchSlots
@@ -401,18 +402,21 @@ module DispatchSlotChecking =
                                 |> not
 
                             let (CompiledSig (vargTys, _, fvmethTypars, _)) = compiledSig
-
-                            if moreThanOnePossibleDispatchSlot then
-                                noimpl()
-
-                            elif argTys.Length <> vargTys.Length then
-                                fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
-                            elif methTypars.Length <> fvmethTypars.Length then
-                                fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
-                            elif not (IsTyparKindMatch compiledSig overrideBy) then
-                                fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
-                            else 
-                                fail(Error(FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.stringOfMethInfo infoReader m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+
+                            // Object expressions can only implement instance members
+                            let isObjExprWithInstanceMembers = (isObjExpr && isInstance)
+                            if isObjExprWithInstanceMembers || isInstance then
+                                if moreThanOnePossibleDispatchSlot then
+                                    noimpl()
+
+                                elif (argTys.Length <> vargTys.Length) then
+                                    fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+                                elif methTypars.Length <> fvmethTypars.Length then
+                                    fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+                                elif not (IsTyparKindMatch compiledSig overrideBy) then
+                                    fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+                                else 
+                                    fail(Error(FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.stringOfMethInfo infoReader m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
                         | overrideBy :: _ -> 
                             errorR(Error(FSComp.SR.typrelOverloadNotFound(FormatMethInfoSig g amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
 
@@ -599,11 +603,18 @@ module DispatchSlotChecking =
                 match relevantVirts |> List.filter (fun dispatchSlot -> IsPartialMatch g dispatchSlot (CompiledSigOfMeth g amap m dispatchSlot) overrideBy) with 
                 | [dispatchSlot] -> 
                     errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m))
-                | _ -> 
+                | _ ->
                     match relevantVirts |> List.filter (fun dispatchSlot -> IsNameMatch dispatchSlot overrideBy) with 
-                    | [] -> errorR(OverrideDoesntOverride(denv, overrideBy, None, g, amap, m))
-                    | [dispatchSlot] -> 
-                        errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m))
+                    | [] ->
+                        if isObjExpr && not overrideBy.IsInstance then
+                            errorR(Error(FSComp.SR.chkStaticMembersOnObjectExpressions(), overrideBy.Range))
+                        else
+                            errorR(OverrideDoesntOverride(denv, overrideBy, None, g, amap, m))
+                    | [dispatchSlot] ->
+                        if isObjExpr && not overrideBy.IsInstance then
+                            errorR(Error(FSComp.SR.chkStaticMembersOnObjectExpressions(), overrideBy.Range))
+                        else
+                            errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m))
                     | possibleDispatchSlots -> 
                        let details =
                             possibleDispatchSlots
@@ -820,7 +831,7 @@ module DispatchSlotChecking =
 
                 if isImplementation && not (isInterfaceTy g overallTy) then 
                     let overrides = allImmediateMembersThatMightImplementDispatchSlots |> List.map snd
-                    let allCorrect = CheckDispatchSlotsAreImplemented (denv, infoReader, m, nenv, sink, tcaug.tcaug_abstract, reqdTy, dispatchSlots, availPriorOverrides, overrides)
+                    let allCorrect = CheckDispatchSlotsAreImplemented (denv, infoReader, m, nenv, sink, tcaug.tcaug_abstract, false, reqdTy, dispatchSlots, availPriorOverrides, overrides)
 
                     // Tell the user to mark the thing abstract if it was missing implementations
                     if not allCorrect && not tcaug.tcaug_abstract && not (isInterfaceTy g reqdTy) then 

src/Compiler/Checking/MethodOverrides.fsi

@@ -113,6 +113,7 @@ module DispatchSlotChecking =
         nenv: NameResolutionEnv *
         sink: TcResultsSink *
         isOverallTyAbstract: bool *
+        isObjExpr: bool *
         reqdTy: TType *
         dispatchSlots: RequiredSlot list *
         availPriorOverrides: OverrideInfo list *

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -1551,7 +1551,7 @@ type Exception with
 
                     // If implementation and required slot doesn't have same "instance-ness", then tell user that.
                     if impl.IsInstance <> minfoVirt.IsInstance then
-                        // Requried slot is instance, meaning implementation is static, tell user that we expect instance.
+                        // Required slot is instance, meaning implementation is static, tell user that we expect instance.
                         if minfoVirt.IsInstance then
                             os.AppendString(OverrideShouldBeStatic().Format)
                         else

src/Compiler/FSComp.txt

@@ -1730,3 +1730,4 @@ featureUnmanagedConstraintCsharpInterop,"Interop between C#'s and F#'s unmanaged
 3584,tcDotLambdaAtNotSupportedExpression,"Shorthand lambda syntax is only supported for atomic expressions, such as method, property, field or indexer on the implied '_' argument. For example: 'let f = _.Length'."
 3855,tcNoStaticMemberFoundForOverride,"No static abstract member was found that corresponds to this override"
 3859,tcNoStaticPropertyFoundForOverride,"No static abstract property was found that corresponds to this override"
+3860,chkStaticMembersOnObjectExpressions,"Static members are not allowed in object expressions."