diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 87b4d58833d..446702b4bda 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6857,8 +6857,8 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) isObjExpr env tpenv wit UnifyTypes cenv env m overallTy objTy // 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) then + let supportsObjectExpressionWithoutOverrides = isObjExpr && g.langVersion.SupportsFeature(LanguageFeature.AllowObjectExpressionWithoutOverrides) + if tycon.MembersOfFSharpTyconByName |> NameMultiMap.existsInRange (fun v -> v.IsIncrClassConstructor) && not supportsObjectExpressionWithoutOverrides then errorR(Error(FSComp.SR.tcConstructorRequiresCall(tycon.DisplayName), m)) let fspecs = tycon.TrueInstanceFieldsAsList @@ -7223,11 +7223,9 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI if argopt.IsSome then error(Error(FSComp.SR.tcNoArgumentsForRecordValue(), mWholeExpr)) if not (isNil extraImpls) then error(Error(FSComp.SR.tcNoInterfaceImplementationForConstructionExpression(), mNewExpr)) - // let supportsObjectExpressionWithoutOverrides = g.langVersion.SupportsFeature(LanguageFeature.AllowObjectExpressionWithoutOverrides) - + let supportsObjectExpressionWithoutOverrides = g.langVersion.SupportsFeature(LanguageFeature.AllowObjectExpressionWithoutOverrides) - let requiresConstructor = GetCtorShapeCounter env <> 1 - if isFSharpObjModelTy g objTy && requiresConstructor then + if isFSharpObjModelTy g objTy && GetCtorShapeCounter env <> 1 && not supportsObjectExpressionWithoutOverrides then error(Error(FSComp.SR.tcObjectConstructionCanOnlyBeUsedInClassTypes(), mNewExpr)) let fldsList = binds |> List.map (fun b -> @@ -7283,20 +7281,17 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI 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 overrideSpecs.IsEmpty && not isOverallTyAbstract && not (isInterfaceTy g objTy) then + errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), mObjTy)) 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, isAbstractClass, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore - + if not hasStaticMembers then DispatchSlotChecking.CheckDispatchSlotsAreImplemented (env.DisplayEnv, cenv.infoReader, m, env.NameEnv, cenv.tcSink, isOverallTyAbstract, true, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore - ) // 3. create the specs of overrides let allTypeImpls = diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs index d76cc6a2d58..ec68cbd2013 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs @@ -64,7 +64,6 @@ let implSomeDU someDu = type Foo() = class end let foo = { new Foo() } -let foo = { new Foo() } // Approved suggestion to allow this https://github.com/fsharp/fslang-suggestions/issues/632 let foo1 = new Foo() @@ -75,7 +74,26 @@ let foo2 = { new Foo() with member __.ToString() = base.ToString() } |> 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.") + ] + + [] + let ``Object expression can implement an abstract class having no abstract members.`` () = + Fsx """ +[] +type Foo() = class end + +let foo = { new Foo() } + +let foo1 = new Foo() + +// hacky workaround +let foo2 = { new Foo() with member __.ToString() = base.ToString() } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ (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.") ] @@ -408,4 +426,4 @@ Please restrict it to one of the following: (Error 358, Line 8, Col 19, Line 8, Col 29, "The override for 'Overloaded: int -> bool' was ambiguous") (Error 358, Line 8, Col 19, Line 8, Col 29, "The override for 'Overloaded: string -> bool' was ambiguous") (Error 783, Line 7, Col 11, Line 7, Col 19, "At least one override did not correctly implement its corresponding abstract member") - ] + ] \ No newline at end of file