Skip to content

Commit f5111c6

Browse files
authored
Merge pull request #17461 from dotnet/merges/main-to-release/dev17.12
Merge main to release/dev17.12
2 parents 0684fca + dd0d5e3 commit f5111c6

File tree

6 files changed

+75
-15
lines changed

6 files changed

+75
-15
lines changed

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212

1313
* 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))
1414
* Change compiler default setting for compressedMetadata ([Issue #17379](https://github.com/dotnet/fsharp/issues/17379), [PR #17383](https://github.com/dotnet/fsharp/pull/17383))
15+
* Treat `{ new Foo() }` as `SynExpr.ObjExpr` ([PR #17388](https://github.com/dotnet/fsharp/pull/17388))
1516
* Optimize metadata reading for type members and custom attributes. ([PR #17364](https://github.com/dotnet/fsharp/pull/17364))
1617
* Enforce `AttributeTargets` on unions. ([PR #17389](https://github.com/dotnet/fsharp/pull/17389))
1718

src/Compiler/Checking/CheckComputationExpressions.fs

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -3454,13 +3454,6 @@ let TcSequenceExpressionEntry (cenv: cenv) env (overallTy: OverallTy) tpenv (has
34543454
let validateObjectSequenceOrRecordExpression = not implicitYieldEnabled
34553455

34563456
match comp with
3457-
| SynExpr.New _ ->
3458-
try
3459-
TcExprUndelayed cenv overallTy env tpenv comp |> ignore
3460-
with RecoverableException e ->
3461-
errorRecovery e m
3462-
3463-
errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), m))
34643457
| SimpleSemicolonSequence cenv false _ when validateObjectSequenceOrRecordExpression ->
34653458
errorR (Error(FSComp.SR.tcInvalidObjectSequenceOrRecordExpression (), m))
34663459
| _ -> ()

src/Compiler/Checking/CheckExpressions.fs

Lines changed: 16 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7273,14 +7273,21 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
72737273
overridesAndVirts |> List.iter (fun (m, implTy, dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, overrides) ->
72747274
let overrideSpecs = overrides |> List.map fst
72757275
let hasStaticMembers = dispatchSlots |> List.exists (fun reqdSlot -> not reqdSlot.MethodInfo.IsInstance)
7276+
let isOverallTyAbstract =
7277+
match tryTcrefOfAppTy g objTy with
7278+
| ValueNone -> false
7279+
| ValueSome tcref -> HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs
7280+
7281+
if overrideSpecs.IsEmpty && not (isInterfaceTy g objTy) then
7282+
errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), mWholeExpr))
72767283

72777284
if hasStaticMembers then
72787285
errorR(Error(FSComp.SR.chkStaticMembersOnObjectExpressions(), mObjTy))
72797286

72807287
DispatchSlotChecking.CheckOverridesAreAllUsedOnce (env.DisplayEnv, g, cenv.infoReader, true, implTy, dispatchSlotsKeyed, availPriorOverrides, overrideSpecs)
72817288

72827289
if not hasStaticMembers then
7283-
DispatchSlotChecking.CheckDispatchSlotsAreImplemented (env.DisplayEnv, cenv.infoReader, m, env.NameEnv, cenv.tcSink, false, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore
7290+
DispatchSlotChecking.CheckDispatchSlotsAreImplemented (env.DisplayEnv, cenv.infoReader, m, env.NameEnv, cenv.tcSink, isOverallTyAbstract, true, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore
72847291
)
72857292

72867293
// 3. create the specs of overrides
@@ -10891,6 +10898,14 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
1089110898
let isFixed, rhsExpr, overallPatTy, overallExprTy =
1089210899
match rhsExpr with
1089310900
| SynExpr.Fixed (e, _) -> true, e, NewInferenceType g, overallTy
10901+
// { new Foo() } is parsed as a SynExpr.ComputationExpr.(See pars.fsy `objExpr` rule).
10902+
// If a SynExpr.ComputationExpr body consists of a single SynExpr.New, and it's not the argument of a computation expression builder type.
10903+
// Then we should treat it as a SynExpr.ObjExpr and make it consistent with the other object expressions. e.g.
10904+
// { new Foo } -> SynExpr.ObjExpr
10905+
// { new Foo() } -> SynExpr.ObjExpr
10906+
// { New Foo with ... } -> SynExpr.ObjExpr
10907+
| SynExpr.ComputationExpr(false, SynExpr.New(_, targetType, expr, m), _) ->
10908+
false, SynExpr.ObjExpr(targetType, Some(expr, None), None, [], [], [], m, rhsExpr.Range), overallTy, overallTy
1089410909
| e -> false, e, overallTy, overallTy
1089510910

1089610911
// Check the attributes of the binding, parameters or return value

src/Compiler/Checking/MethodOverrides.fs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -324,6 +324,7 @@ module DispatchSlotChecking =
324324
let CheckDispatchSlotsAreImplemented (denv, infoReader: InfoReader, m,
325325
nenv, sink: TcResultsSink,
326326
isOverallTyAbstract,
327+
isObjExpr,
327328
reqdTy,
328329
dispatchSlots: RequiredSlot list,
329330
availPriorOverrides: OverrideInfo list,
@@ -332,7 +333,7 @@ module DispatchSlotChecking =
332333
let amap = infoReader.amap
333334

334335
let isReqdTyInterface = isInterfaceTy g reqdTy
335-
let showMissingMethodsAndRaiseErrors = (isReqdTyInterface || not isOverallTyAbstract)
336+
let showMissingMethodsAndRaiseErrors = (isReqdTyInterface || not isOverallTyAbstract) || (isOverallTyAbstract && isObjExpr)
336337

337338
let mutable res = true
338339
let fail exn =
@@ -824,7 +825,7 @@ module DispatchSlotChecking =
824825

825826
if isImplementation && not (isInterfaceTy g overallTy) then
826827
let overrides = allImmediateMembersThatMightImplementDispatchSlots |> List.map snd
827-
let allCorrect = CheckDispatchSlotsAreImplemented (denv, infoReader, m, nenv, sink, tcaug.tcaug_abstract, reqdTy, dispatchSlots, availPriorOverrides, overrides)
828+
let allCorrect = CheckDispatchSlotsAreImplemented (denv, infoReader, m, nenv, sink, tcaug.tcaug_abstract, false, reqdTy, dispatchSlots, availPriorOverrides, overrides)
828829

829830
// Tell the user to mark the thing abstract if it was missing implementations
830831
if not allCorrect && not tcaug.tcaug_abstract && (isClassTy g reqdTy) then

src/Compiler/Checking/MethodOverrides.fsi

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -113,6 +113,7 @@ module DispatchSlotChecking =
113113
nenv: NameResolutionEnv *
114114
sink: TcResultsSink *
115115
isOverallTyAbstract: bool *
116+
isObjExpr: bool *
116117
reqdTy: TType *
117118
dispatchSlots: RequiredSlot list *
118119
availPriorOverrides: OverrideInfo list *

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

Lines changed: 54 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -65,17 +65,66 @@ type Foo() = class end
6565
6666
let foo = { new Foo() } // Approved suggestion to allow this https://github.com/fsharp/fslang-suggestions/issues/632
6767
68+
let foo1 = new Foo()
69+
6870
// hacky workaround
69-
let foo = { new Foo() with member __.ToString() = base.ToString() }
71+
let foo2 = { new Foo() with member __.ToString() = base.ToString() }
72+
"""
73+
|> withLangVersion80
74+
|> typecheck
75+
|> shouldFail
76+
|> withDiagnostics [
77+
(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.")
78+
(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.")
79+
]
80+
81+
[<Fact>]
82+
let ``Error when object expression does not implement all abstract members of the abstract class`` () =
83+
Fsx """
84+
[<AbstractClass>]
85+
type B() =
86+
abstract M : int -> float
87+
abstract M : string -> unit
88+
and [<AbstractClass>]
89+
C() =
90+
inherit B()
91+
static let v = { new C() with
92+
member x.M(a:int) : float = 1.0 }
93+
default x.M(a:int) : float = 1.0
94+
95+
let y = { new C() with
96+
member x.M(a:int) : float = 1.0 }
97+
"""
98+
|> withLangVersion80
99+
|> typecheck
100+
|> shouldFail
101+
|> withDiagnostics [
102+
(Error 365, Line 9, Col 20, Line 10, Col 60, "No implementation was given for 'abstract B.M: string -> unit'")
103+
(Error 365, Line 13, Col 9, Line 14, Col 49, "No implementation was given for 'abstract B.M: string -> unit'")
104+
]
105+
106+
[<Fact>]
107+
let ``Error when object expression does not implement all abstract members of a generic abstract class`` () =
108+
Fsx """
109+
[<AbstractClass>]
110+
type BaseHashtable<'Entry, 'Key>(initialCapacity) =
111+
abstract member Next : entries : 'Entry array -> int
112+
113+
[<Struct>]
114+
type StrongToWeakEntry<'Value when 'Value : not struct> =
115+
val mutable public next : int
116+
117+
let f() = { new BaseHashtable<_,_>(2) with
118+
override this.Next (entries:StrongToWeakEntry<_> array) = 1
119+
override this.Next entries = 1
120+
}
70121
"""
71122
|> withLangVersion80
72123
|> typecheck
73124
|> shouldFail
74125
|> withDiagnostics [
75-
(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.");
76-
(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.")
77-
(Error 740, Line 5, Col 11, Line 5, Col 24, "Invalid record, sequence or computation expression. Sequence expressions should be of the form 'seq { ... }'")
78-
]
126+
(Error 359, Line 10, Col 11, Line 13, Col 12, "More than one override implements 'Next: StrongToWeakEntry<'a> array -> int when 'a: not struct'")
127+
]
79128

80129
[<Fact>]
81130
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`` () =

0 commit comments

Comments
 (0)