Treat { new Foo() } as SynExpr.ObjExpr (#17388)

docs/release-notes/.FSharp.Compiler.Service/9.0.100.md

@@ -12,6 +12,7 @@
 
 * Change compiler default setting realsig+ when building assemblies ([Issue #17384](https://github.com/dotnet/fsharp/issues/17384), [PR #17378](https://github.com/dotnet/fsharp/pull/17385))
 * Change compiler default setting for compressedMetadata ([Issue #17379](https://github.com/dotnet/fsharp/issues/17379), [PR #17383](https://github.com/dotnet/fsharp/pull/17383))
+* Treat `{ new Foo() }` as `SynExpr.ObjExpr` ([PR #17388](https://github.com/dotnet/fsharp/pull/17388))
 * Optimize metadata reading for type members and custom attributes. ([PR #17364](https://github.com/dotnet/fsharp/pull/17364))
 * Enforce `AttributeTargets` on unions. ([PR #17389](https://github.com/dotnet/fsharp/pull/17389))
 

src/Compiler/Checking/CheckComputationExpressions.fs

@@ -3454,13 +3454,6 @@ let TcSequenceExpressionEntry (cenv: cenv) env (overallTy: OverallTy) tpenv (has
         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))
         | _ -> ()

src/Compiler/Checking/CheckExpressions.fs

@@ -7273,14 +7273,21 @@ 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))
 
             DispatchSlotChecking.CheckOverridesAreAllUsedOnce (env.DisplayEnv, g, cenv.infoReader, true, implTy, dispatchSlotsKeyed, availPriorOverrides, overrideSpecs)
 
             if not hasStaticMembers then
-                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, isOverallTyAbstract, true, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore
             )
 
         // 3. create the specs of overrides
@@ -10891,6 +10898,14 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
         let isFixed, rhsExpr, overallPatTy, overallExprTy =
             match rhsExpr with
             | SynExpr.Fixed (e, _) -> true, e, NewInferenceType g, overallTy
+            // { new Foo()  } is parsed as a SynExpr.ComputationExpr.(See pars.fsy `objExpr` rule).
+            // If a SynExpr.ComputationExpr body consists of a single SynExpr.New, and it's not the argument of a computation expression builder type.
+            // Then we should treat it as a SynExpr.ObjExpr and make it consistent with the other object expressions. e.g.
+            // { new Foo } -> SynExpr.ObjExpr
+            // { new Foo() } -> SynExpr.ObjExpr
+            // { New Foo with ... } -> SynExpr.ObjExpr
+            | SynExpr.ComputationExpr(false, SynExpr.New(_, targetType, expr, m), _) ->        
+                false, SynExpr.ObjExpr(targetType, Some(expr, None), None, [], [], [], m, rhsExpr.Range), overallTy, overallTy
             | e -> false, e, overallTy, overallTy
 
         // Check the attributes of the binding, parameters or return value

src/Compiler/Checking/MethodOverrides.fs

@@ -324,6 +324,7 @@ module DispatchSlotChecking =
     let CheckDispatchSlotsAreImplemented (denv, infoReader: InfoReader, m,
                                           nenv, sink: TcResultsSink,
                                           isOverallTyAbstract,
+                                          isObjExpr,
                                           reqdTy,
                                           dispatchSlots: RequiredSlot list,
                                           availPriorOverrides: OverrideInfo list,
@@ -332,7 +333,7 @@ module DispatchSlotChecking =
         let amap = infoReader.amap
 
         let isReqdTyInterface = isInterfaceTy g reqdTy
-        let showMissingMethodsAndRaiseErrors = (isReqdTyInterface || not isOverallTyAbstract)
+        let showMissingMethodsAndRaiseErrors = (isReqdTyInterface || not isOverallTyAbstract) || (isOverallTyAbstract && isObjExpr)
 
         let mutable res = true
         let fail exn =
@@ -824,7 +825,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 && (isClassTy 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 *

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

@@ -65,17 +65,66 @@ type Foo() = class end
 
 let foo = { new Foo() } // Approved suggestion to allow this https://github.com/fsharp/fslang-suggestions/issues/632
 
+let foo1 = new Foo()
+
 // hacky workaround
-let foo = { new Foo() with member __.ToString() = base.ToString() }
+let foo2 = { new Foo() with member __.ToString() = base.ToString() }
+        """
+         |> withLangVersion80
+         |> typecheck
+         |> shouldFail
+         |> withDiagnostics [
+             (Error 738, Line 5, Col 11, Line 5, Col 24, "Invalid object expression. Objects without overrides or interfaces should use the expression form 'new Type(args)' without braces.")
+             (Error 759, Line 7, Col 12, Line 7, Col 21, "Instances of this type cannot be created since it has been marked abstract or not all methods have been given implementations. Consider using an object expression '{ new ... with ... }' instead.")
+         ] 
+
+    [<Fact>]
+    let ``Error when object expression does not implement all abstract members of the abstract class`` () =
+        Fsx """
+[<AbstractClass>]
+type B() = 
+    abstract M : int -> float
+    abstract M : string -> unit
+and [<AbstractClass>]
+    C() = 
+    inherit B()
+    static let v = { new C() with 
+                         member x.M(a:int) : float  = 1.0 }
+    default x.M(a:int) : float  = 1.0
+    
+let y = { new C() with 
+              member x.M(a:int) : float  = 1.0 }
+        """
+         |> withLangVersion80
+         |> typecheck
+         |> shouldFail
+         |> withDiagnostics [
+             (Error 365, Line 9, Col 20, Line 10, Col 60, "No implementation was given for 'abstract B.M: string -> unit'")
+             (Error 365, Line 13, Col 9, Line 14, Col 49, "No implementation was given for 'abstract B.M: string -> unit'")
+         ]
+
+    [<Fact>]
+    let ``Error when object expression does not implement all abstract members of a generic abstract class`` () =
+        Fsx """
+[<AbstractClass>]
+type BaseHashtable<'Entry, 'Key>(initialCapacity) =
+    abstract member Next : entries : 'Entry array -> int
+
+[<Struct>]    
+type StrongToWeakEntry<'Value when 'Value : not struct> =
+    val mutable public next : int
+
+let f() = { new BaseHashtable<_,_>(2) with
+            override this.Next (entries:StrongToWeakEntry<_> array) = 1
+            override this.Next entries = 1
+          }
         """
          |> withLangVersion80
          |> typecheck
          |> shouldFail
          |> withDiagnostics [
-            (Error 759, Line 5, Col 13, Line 5, Col 22, "Instances of this type cannot be created since it has been marked abstract or not all methods have been given implementations. Consider using an object expression '{ new ... with ... }' instead.");
-            (Error 738, Line 5, Col 11, Line 5, Col 24, "Invalid object expression. Objects without overrides or interfaces should use the expression form 'new Type(args)' without braces.")
-            (Error 740, Line 5, Col 11, Line 5, Col 24, "Invalid record, sequence or computation expression. Sequence expressions should be of the form 'seq { ... }'")
-         ]     
+             (Error 359, Line 10, Col 11, Line 13, Col 12, "More than one override implements 'Next: StrongToWeakEntry<'a> array -> int when 'a: not struct'")
+         ]
 
     [<Fact>]
     let ``Object expression can not implementing an interface when it contains a method with no types that can refer to the type for which the implementation is being used`` () =