Fix object-expr untested cases (#17476)

* Fix object-expr untested case

* Update condition to cover new found cases

* Better test names

* one more test

---------

Co-authored-by: Kevin Ransom (msft) <[email protected]>

Author: edgarfgp

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -7119,12 +7119,14 @@ and CheckSuperType (cenv: cenv) ty m =
 and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraImpls, mObjTy, mNewExpr, mWholeExpr) =
 
     let g = cenv.g
-
     match tryTcrefOfAppTy g objTy with
     | ValueNone -> error(Error(FSComp.SR.tcNewMustBeUsedWithNamedType(), mNewExpr))
     | ValueSome tcref ->
     let isRecordTy = tcref.IsRecordTycon
-    if not isRecordTy && not (isInterfaceTy g objTy) && isSealedTy g objTy then errorR(Error(FSComp.SR.tcCannotCreateExtensionOfSealedType(), mNewExpr))
+    let isInterfaceTy = isInterfaceTy g objTy
+    let isFSharpObjModelTy = isFSharpObjModelTy g objTy
+    let isOverallTyAbstract = HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs
+    if not isRecordTy && not isInterfaceTy && isSealedTy g objTy then errorR(Error(FSComp.SR.tcCannotCreateExtensionOfSealedType(), mNewExpr))
 
     CheckSuperType cenv objTy mObjTy
 
@@ -7135,14 +7137,14 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
     let env = EnterFamilyRegion tcref env
     let ad = env.AccessRights
 
-    if // record construction ?
+    if // record construction ? e.g { A = 1; B = 2 }
        isRecordTy ||
-       // object construction?
-       (isFSharpObjModelTy g objTy && not (isInterfaceTy g objTy) && argopt.IsNone) then
+       // object construction?  e.g. new A() { ... }
+       (isFSharpObjModelTy && not isInterfaceTy && argopt.IsNone) then
 
         if argopt.IsSome then error(Error(FSComp.SR.tcNoArgumentsForRecordValue(), mWholeExpr))
         if not (isNil extraImpls) then error(Error(FSComp.SR.tcNoInterfaceImplementationForConstructionExpression(), mNewExpr))
-        if isFSharpObjModelTy g objTy && GetCtorShapeCounter env <> 1 then
+        if isFSharpObjModelTy && GetCtorShapeCounter env <> 1 then
             error(Error(FSComp.SR.tcObjectConstructionCanOnlyBeUsedInClassTypes(), mNewExpr))
         let fldsList =
             binds |> List.map (fun b ->
@@ -7152,8 +7154,9 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
 
         TcRecordConstruction cenv objTy true env tpenv None objTy fldsList mWholeExpr
     else
+        // object expression construction e.g. { new A() with ... } or { new IA with ... }
         let ctorCall, baseIdOpt, tpenv =
-            if isInterfaceTy g objTy then
+            if isInterfaceTy then
                 match argopt with
                 | None ->
                     BuildObjCtorCall g mWholeExpr, None, tpenv
@@ -7162,7 +7165,7 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
             else
                 let item = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mObjTy ad objTy)
 
-                if isFSharpObjModelTy g objTy && GetCtorShapeCounter env = 1 then
+                if isFSharpObjModelTy && GetCtorShapeCounter env = 1 then
                     error(Error(FSComp.SR.tcObjectsMustBeInitializedWithObjectExpression(), mNewExpr))
 
                 match item, argopt with
@@ -7193,14 +7196,6 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
         overridesAndVirts |> List.iter (fun (m, implTy, dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, overrides) ->
             let overrideSpecs = overrides |> List.map fst
             let hasStaticMembers = dispatchSlots |> List.exists (fun reqdSlot -> not reqdSlot.MethodInfo.IsInstance)
-            let isOverallTyAbstract =
-                match tryTcrefOfAppTy g objTy with
-                | ValueNone -> false
-                | ValueSome tcref -> HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs
-                
-            if overrideSpecs.IsEmpty && not (isInterfaceTy g objTy) then
-                errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), mWholeExpr))
-
             if hasStaticMembers then
                 errorR(Error(FSComp.SR.chkStaticMembersOnObjectExpressions(), mObjTy))
 
@@ -7240,8 +7235,11 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
         let objtyR, overrides' = allTypeImpls.Head
         assert (typeEquiv g objTy objtyR)
         let extraImpls = allTypeImpls.Tail
+            
+        if not isInterfaceTy && (isOverallTyAbstract && overrides'.IsEmpty) && extraImpls.IsEmpty then
+           errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), mWholeExpr))
 
-        // 7. Build the implementation
+        // 4. Build the implementation
         let expr = mkObjExpr(objtyR, baseValOpt, ctorCall, overrides', extraImpls, mWholeExpr)
         let expr = mkCoerceIfNeeded g realObjTy objtyR expr
         expr, tpenv

src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs

@@ -444,20 +444,12 @@ let TcSequenceExpressionEntry (cenv: TcFileState) env (overallTy: OverallTy) tpe
     match RewriteRangeExpr comp with
     | Some replacementExpr -> TcExpr cenv overallTy env tpenv replacementExpr
     | None ->
-
         let implicitYieldEnabled =
             cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield
 
         let validateObjectSequenceOrRecordExpression = not implicitYieldEnabled
 
         match comp with
-        | SynExpr.New _ ->
-            try
-                TcExprUndelayed cenv overallTy env tpenv comp |> ignore
-            with RecoverableException e ->
-                errorRecovery e m
-
-            errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), m))
         | SimpleSemicolonSequence cenv false _ when validateObjectSequenceOrRecordExpression ->
             errorR (Error(FSComp.SR.tcInvalidObjectSequenceOrRecordExpression (), m))
         | _ -> ()

tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs

@@ -33,6 +33,93 @@ let implementer() ={ new IFirst  }
          |> withLangVersion80
          |> typecheck
          |> shouldSucceed
+
+    [<Fact>]
+    let ``Object expression can construct an abstract class and also implement interfaces with and without abstract members.`` () =
+        Fsx """
+type IFirst = interface end
+
+type ISecond =
+    abstract member M : unit -> unit
+    
+[<AbstractClass>]
+type MyClass() = class end
+
+{ new MyClass() with
+    member x.ToString() = "OK"
+    
+  interface IFirst
+  
+  interface ISecond with
+      member this.M() = () } |> ignore
+        """
+         |> withLangVersion80
+         |> typecheck
+         |> shouldSucceed
+         
+    [<Fact>]
+    let ``Object expression can construct an abstract class(missing with...) and also implement interfaces with and without abstract members.`` () =
+        Fsx """
+type IFirst = interface end
+
+type ISecond =
+    abstract member M : unit -> unit
+    
+[<AbstractClass>]
+type MyClass() = class end
+
+{ new MyClass() interface IFirst
+  
+  interface ISecond with
+      member this.M() = () } |> ignore
+        """
+         |> withLangVersion80
+         |> typecheck
+         |> shouldSucceed
+         
+    [<Fact>]
+    let ``Object expression can construct an abstract class(missing with... and interface in the next line) and also implement interfaces with and without abstract members.`` () =
+        Fsx """
+type IFirst = interface end
+
+type ISecond =
+    abstract member M : unit -> unit
+    
+[<AbstractClass>]
+type MyClass() = class end
+
+{ new MyClass()
+    interface IFirst
+  
+  interface ISecond with
+      member this.M() = () } |> ignore
+        """
+         |> withLangVersion80
+         |> typecheck
+         |> shouldSucceed
+         
+    [<Fact>]
+    let ``Verifies that the object expression built type has the interface.`` () =
+        Fsx """
+type IFirst = interface end
+
+type ISecond =
+    abstract member M : unit -> unit
+    
+[<AbstractClass>]
+type MyClass() =
+    interface ISecond with
+        member this.M() = printfn "It works"
+
+let expr = { new MyClass() interface IFirst }
+(expr:> ISecond).M()
+        """
+         |> withLangVersion80
+         |> compileExeAndRun
+         |> shouldSucceed
+         |> withStdOutContainsAllInOrder [
+           "It works"
+        ]
 
     [<Fact>]
     let ``Parameterized object expression implementing an interface with members`` () =