From df43ab1ba88fbb968b0593f4fce9ee9741039870 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Mon, 29 Jul 2024 17:49:53 +0100 Subject: [PATCH] Treat `{ new Foo() }` as `SynExpr.ObjExpr` (#17388) --- .../.FSharp.Compiler.Service/9.0.100.md | 1 + .../Checking/CheckComputationExpressions.fs | 7 --- src/Compiler/Checking/CheckExpressions.fs | 17 +++++- src/Compiler/Checking/MethodOverrides.fs | 5 +- src/Compiler/Checking/MethodOverrides.fsi | 1 + .../ObjectExpressions/ObjectExpressions.fs | 59 +++++++++++++++++-- 6 files changed, 75 insertions(+), 15 deletions(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md index 1166f8b413e..56c6126d217 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md +++ b/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)) diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index 9703087e92b..10b14cd7b1c 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/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)) | _ -> () diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index bb4a5055e2d..08c71018f05 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -7273,6 +7273,13 @@ 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)) @@ -7280,7 +7287,7 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI 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 diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 8d292666eeb..acec41cd479 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/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 diff --git a/src/Compiler/Checking/MethodOverrides.fsi b/src/Compiler/Checking/MethodOverrides.fsi index 6468c03e8b1..b06fb16e499 100644 --- a/src/Compiler/Checking/MethodOverrides.fsi +++ b/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 * diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs index a53252356de..0a3eb93cf55 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs +++ b/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.") + ] + + [] + let ``Error when object expression does not implement all abstract members of the abstract class`` () = + Fsx """ +[] +type B() = + abstract M : int -> float + abstract M : string -> unit +and [] + 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'") + ] + + [] + let ``Error when object expression does not implement all abstract members of a generic abstract class`` () = + Fsx """ +[] +type BaseHashtable<'Entry, 'Key>(initialCapacity) = + abstract member Next : entries : 'Entry array -> int + +[] +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'") + ] [] 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`` () =