more tests

dotnet · Aug 14, 2024 · 2233c5f · 2233c5f
1 parent cb9b78e
commit 2233c5f
Show file tree

Hide file tree

Showing 2 changed files with 64 additions and 3 deletions.
diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs
@@ -6792,7 +6792,7 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) isObjExpr env tpenv wit
 
     // Types with implicit constructors can't use record or object syntax: all constructions must go through the implicit constructor
     let supportsObjectExpressionWithoutOverrides = isObjExpr && g.langVersion.SupportsFeature(LanguageFeature.AllowObjectExpressionWithoutOverrides)
-    if tycon.MembersOfFSharpTyconByName |> NameMultiMap.existsInRange (fun v -> v.IsIncrClassConstructor) && not supportsObjectExpressionWithoutOverrides then
+    if not supportsObjectExpressionWithoutOverrides && tycon.MembersOfFSharpTyconByName |> NameMultiMap.existsInRange (fun v -> v.IsIncrClassConstructor) then
         errorR(Error(FSComp.SR.tcConstructorRequiresCall(tycon.DisplayName), m))
 
     let fspecs = tycon.TrueInstanceFieldsAsList
@@ -7140,7 +7140,8 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
     let isRecordTy = tcref.IsRecordTycon
     let isInterfaceTy = isInterfaceTy g objTy
     let isFSharpObjModelTy = isFSharpObjModelTy g objTy
-    let isOverallTyAbstract = HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs
+    let isOverallTyAbstract = HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs || isAbstractTycon tcref.Deref
+
     if not isRecordTy && not isInterfaceTy && isSealedTy g objTy then errorR(Error(FSComp.SR.tcCannotCreateExtensionOfSealedType(), mNewExpr))
 
     CheckSuperType cenv objTy mObjTy
@@ -7251,7 +7252,6 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
         assert (typeEquiv g objTy objtyR)
         let extraImpls = allTypeImpls.Tail
         let supportsObjectExpressionWithoutOverrides = g.langVersion.SupportsFeature(LanguageFeature.AllowObjectExpressionWithoutOverrides)
-        let isOverallTyAbstract = isOverallTyAbstract || isAbstractTycon tcref.Deref
 
         if not supportsObjectExpressionWithoutOverrides && not isInterfaceTy && (isOverallTyAbstract && overrides'.IsEmpty) && extraImpls.IsEmpty then
            errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), mWholeExpr))

diff --git a/...rp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs b/...rp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs
@@ -252,7 +252,68 @@ let res = { new AbstractClass() }
          |> withDiagnostics [
              (Error 738, Line 6, Col 11, Line 6, Col 34, "Invalid object expression. Objects without overrides or interfaces should use the expression form 'new Type(args)' without braces.")
          ]
+
+    [<Fact>]
+    let ``Object expression can not implement an abstract class having abstract members with default implementation`` () =
+        Fsx """
+[<AbstractClass>]
+type AbstractClass() =
+    abstract member M : unit -> unit
+    default this.M() = printfn "Im a default implementation"
+    
+let res = { new AbstractClass() }
+        """
+         |> withLangVersion80
+         |> typecheck
+         |> shouldFail
+         |> withDiagnostics [
+             (Error 738, Line 7, Col 11, Line 7, Col 34, "Invalid object expression. Objects without overrides or interfaces should use the expression form 'new Type(args)' without braces.")
+         ]
+
+    [<Fact>]
+    let ``Object expression can implement an abstract class having abstract members with default implementation preview`` () =
+        Fsx """
+[<AbstractClass>]
+type AbstractClass() =
+    abstract member M : unit -> unit
+    default this.M() = printfn "Im a default implementation"
+    
+let res = { new AbstractClass() }
+        """
+         |> withLangVersionPreview
+         |> typecheck
+         |> shouldSucceed
+
+    [<Fact>]
+    let ``Object expression can implement an abstract class(overriding a member) having abstract members with default implementation`` () =
+        Fsx """
+[<AbstractClass>]
+type AbstractClass() =
+    abstract member M : unit -> unit
+    default this.M() = printfn "Im a default implementation"
+    
+let res = { new AbstractClass() with
+                override this.ToString() = "ConcreteMethod" }
+        """
+         |> withLangVersion80
+         |> typecheck
+         |> shouldSucceed
 
+    [<Fact>]
+    let ``Object expression can implement an abstract class(overriding a member) having abstract members with default implementation preview`` () =
+        Fsx """
+[<AbstractClass>]
+type AbstractClass() =
+    abstract member M : unit -> unit
+    default this.M() = printfn "Im a default implementation"
+    
+let res = { new AbstractClass() with
+                override this.ToString() = "ConcreteMethod" }
+        """
+         |> withLangVersionPreview
+         |> typecheck
+         |> shouldSucceed
+
     [<Fact>]
     let ``Object expression can not implement an abstract class having abstract members`` () =
         Fsx """