Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merge main to release/dev17.12 #17461

Merged
merged 2 commits into from
Jul 30, 2024
Merged
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Next Next commit
Treat { new Foo() } as SynExpr.ObjExpr (#17388)
  • Loading branch information
edgarfgp authored Jul 29, 2024

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature. The key has expired.
commit df43ab1ba88fbb968b0593f4fce9ee9741039870
1 change: 1 addition & 0 deletions docs/release-notes/.FSharp.Compiler.Service/9.0.100.md
Original file line number Diff line number Diff line change
@@ -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))

7 changes: 0 additions & 7 deletions src/Compiler/Checking/CheckComputationExpressions.fs
Original file line number Diff line number Diff line change
@@ -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))
| _ -> ()
17 changes: 16 additions & 1 deletion src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
@@ -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
5 changes: 3 additions & 2 deletions src/Compiler/Checking/MethodOverrides.fs
Original file line number Diff line number Diff line change
@@ -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
1 change: 1 addition & 0 deletions src/Compiler/Checking/MethodOverrides.fsi
Original file line number Diff line number Diff line change
@@ -113,6 +113,7 @@ module DispatchSlotChecking =
nenv: NameResolutionEnv *
sink: TcResultsSink *
isOverallTyAbstract: bool *
isObjExpr: bool *
reqdTy: TType *
dispatchSlots: RequiredSlot list *
availPriorOverrides: OverrideInfo list *
Original file line number Diff line number Diff line change
@@ -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`` () =
Loading