diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs index da634239640..5665e13457b 100644 --- a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs @@ -33,14 +33,15 @@ let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) | x :: [] -> x :: res | x :: y :: ys -> match x, y with - | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (_, Some (SynExpr.Record (recordFields = bFlds))) -> + | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, fields1, m))), (_, Some (SynExpr.Record (recordFields = fields2))) -> let reducedRecd = - (lidwid, Some(SynExpr.Record(baseInfo, copyInfo, aFlds @ bFlds, m))) + (lidwid, Some(SynExpr.Record(baseInfo, copyInfo, fields1 @ fields2, m))) groupIfNested res (reducedRecd :: ys) - | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (_, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> + | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, fields1, m, trivia))), + (_, Some (SynExpr.AnonRecd (recordFields = fields2))) -> let reducedRecd = - (lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, aFlds @ bFlds, m, trivia))) + (lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1 @ fields2, m, trivia))) groupIfNested res (reducedRecd :: ys) | _ -> groupIfNested (x :: res) (y :: ys) @@ -55,8 +56,8 @@ let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) /// Expands a long identifier into nested copy-and-update expressions. /// -/// `{ x with A.B = 0 }` becomes `{ x with A = { x.A with B = 0 } }` -let TransformAstForNestedUpdates (cenv: TcFileState) env overallTy (lid: LongIdent) exprBeingAssigned withExpr = +/// `{ x with A.B = 0; A.C = "" }` becomes `{ x with A = { x.A with B = 0 }; A = { x.A with C = "" } }` +let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid: LongIdent) exprBeingAssigned withExpr = let recdExprCopyInfo ids withExpr id = let upToId origSepRng id lidwd = let rec buildLid res (id: Ident) = @@ -102,31 +103,33 @@ let TransformAstForNestedUpdates (cenv: TcFileState) env overallTy (lid: LongIde Some(SynExpr.LongIdent(false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) | _ -> None - let rec synExprRecd copyInfo (id: Ident) fields exprBeingAssigned = - match fields with + let rec synExprRecd copyInfo (outerFieldId: Ident) innerFields exprBeingAssigned = + match innerFields with | [] -> failwith "unreachable" - | (fieldId, anonInfo) :: rest -> + | (fieldId: Ident, item) :: rest -> + CallNameResolutionSink cenv.tcSink (fieldId.idRange, env.NameEnv, item, [], ItemOccurence.Use, env.AccessRights) + + let fieldId = ident (fieldId.idText, fieldId.idRange.MakeSynthetic()) + let nestedField = if rest.IsEmpty then exprBeingAssigned else synExprRecd copyInfo fieldId rest exprBeingAssigned - let m = id.idRange.MakeSynthetic() - - match anonInfo with - | Some { - AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct - } -> + match item with + | Item.AnonRecdField(anonInfo = { + AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct + }) -> let fields = [ LongIdentWithDots([ fieldId ], []), None, nestedField ] - SynExpr.AnonRecd(isStruct, copyInfo id, fields, m, { OpeningBraceRange = range0 }) + SynExpr.AnonRecd(isStruct, copyInfo outerFieldId, fields, outerFieldId.idRange, { OpeningBraceRange = range0 }) | _ -> let fields = [ SynExprRecordField((LongIdentWithDots([ fieldId ], []), true), None, Some nestedField, None) ] - SynExpr.Record(None, copyInfo id, fields, m) + SynExpr.Record(None, copyInfo outerFieldId, fields, outerFieldId.idRange) let access, fields = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid @@ -134,7 +137,12 @@ let TransformAstForNestedUpdates (cenv: TcFileState) env overallTy (lid: LongIde match access, fields with | _, [] -> failwith "unreachable" | accessIds, [ (fieldId, _) ] -> (accessIds, fieldId), Some exprBeingAssigned - | accessIds, (fieldId, _) :: rest -> + | accessIds, (outerFieldId, item) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) - (accessIds, fieldId), Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) fieldId rest exprBeingAssigned) + CallNameResolutionSink cenv.tcSink (outerFieldId.idRange, env.NameEnv, item, [], ItemOccurence.Use, env.AccessRights) + + let outerFieldId = ident (outerFieldId.idText, outerFieldId.idRange.MakeSynthetic()) + + (accessIds, outerFieldId), + Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) outerFieldId rest exprBeingAssigned) diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi index b4eb4bc9948..f239c824361 100644 --- a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi @@ -3,6 +3,7 @@ module internal FSharp.Compiler.CheckRecordSyntaxHelpers open FSharp.Compiler.CheckBasics +open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.TypedTree diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 5bb452afb56..0da7c028eac 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -178,7 +178,7 @@ type Item = | UnionCaseField of UnionCaseInfo * fieldIndex: int /// Represents the resolution of a name to a field of an anonymous record type. - | AnonRecdField of AnonRecdTypeInfo * TTypes * int * range + | AnonRecdField of anonInfo: AnonRecdTypeInfo * tys: TTypes * fieldIndex: int * range: range // The following are never in the items table but are valid results of binding // an identifier in different circumstances. @@ -3745,7 +3745,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = match tryDestAnonRecdTy g ty with | ValueSome (anonInfo, tys) -> match anonInfo.SortedNames |> Array.tryFindIndex (fun x -> x = id.idText) with - | Some index -> OneSuccess (Choice2Of2 (anonInfo, tys[index])) + | Some index -> OneSuccess (Item.AnonRecdField (anonInfo, tys, index, m)) | _ -> raze (Error(FSComp.SR.nrRecordDoesNotContainSuchLabel(NicePrint.minimalStringOfType nenv.eDisplayEnv ty, id.idText), m)) | _ -> let otherRecordFields ty = @@ -3760,7 +3760,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = if isRecdTy g ty then match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with - | ValueSome (RecdFieldInfo (_, rfref)) -> OneSuccess (Choice1Of2 rfref) + | ValueSome info -> OneSuccess (Item.RecdField info) | _ -> // record label doesn't belong to record type -> suggest other labels of same record let suggestLabels addToBuffer = @@ -3776,22 +3776,17 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = // Eliminate duplicates arising from multiple 'open' fields |> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) - |> List.map Choice1Of2 + |> List.map (fun rfref -> Item.RecdField (FreshenRecdFieldRef ncenv m rfref)) |> success | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecordFields ty)) - let anonRecdInfoF field = - match field with - | Choice1Of2 _ -> None - | Choice2Of2 (anonInfo, _) -> Some anonInfo - match lid with | [] -> [], [] | [ id ] -> let res = lookupField recdTy id |> ForceRaise - |> List.map (fun x -> id, anonRecdInfoF x) + |> List.map (fun x -> id, x) [], res | id :: _ -> @@ -3799,10 +3794,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = match lid with | id :: rest -> lookupField recdTy id - |?> List.map (fun x -> - match x with - | Choice1Of2 rfref -> None, id, rfref.RecdField.FormalType, rest - | Choice2Of2 (anonInfo, fldTy) -> Some anonInfo, id, fldTy, rest) + |?> List.map (fun x -> id, x, rest) | _ -> NoResultsOrUsefulErrors let tyconSearch ad () = @@ -3818,7 +3810,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 tyconId.idRange ad fieldId rest typeNameResInfo fieldId.idRange tcrefs |?> List.choose (fun x -> match x with - | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> Some (None, fieldId, rfref.RecdField.FormalType, rest) + | _, (Item.RecdField _ as item), rest -> Some (fieldId, item, rest) | _ -> None) | _ -> NoResultsOrUsefulErrors @@ -3829,9 +3821,9 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap modOrNsId.idRange OpenQualified nenv ad modOrNsId rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) |?> List.map (fun (_, FieldResolution(rfinfo, _), restAfterField) -> let fieldId = rest.[ rest.Length - restAfterField.Length - 1 ] - None, fieldId, rfinfo.RecdField.FormalType, restAfterField) + fieldId, Item.RecdField rfinfo, restAfterField) - let anonRecdInfo, fieldId, fieldTy, rest = + let fieldId, item, rest = let search = if isAnonRecdTy then fieldSearch () @@ -3849,24 +3841,29 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = lid |> List.takeWhile (fun id -> not (equals id.idRange fieldId.idRange)) match rest with - | [] -> idsBeforeField, [ (fieldId, anonRecdInfo) ] + | [] -> idsBeforeField, [ (fieldId, item) ] | _ -> - let rec nestedFieldSearch fields ty lid = + let rec nestedFieldSearch fields parentTy lid = match lid with | [] -> fields | id :: rest -> - let resolved = lookupField ty id |> ForceRaise + let resolved = lookupField parentTy id |> ForceRaise let fieldTy = match resolved with - | [ Choice1Of2 rfref ] -> rfref.RecdField.FormalType - | [ Choice2Of2 (_, fieldTy) ] -> fieldTy - | _ -> ty - - let resolved = resolved |> List.map (fun x -> id, anonRecdInfoF x) + | [ Item.RecdField info ] -> info.FieldType + | [ Item.AnonRecdField (_, tys, index, _) ] -> tys[index] + | _ -> parentTy + let resolved = resolved |> List.map (fun x -> id, x) nestedFieldSearch (fields @ resolved) fieldTy rest - idsBeforeField, (fieldId, anonRecdInfo) :: (nestedFieldSearch [] fieldTy rest) + let fieldTy = + match item with + | Item.RecdField info -> info.FieldType + | Item.AnonRecdField (_, tys, index, _) -> tys[index] + | _ -> g.obj_ty + + idsBeforeField, (fieldId, item) :: (nestedFieldSearch [] fieldTy rest) /// Resolve F#/IL "." syntax in expressions (2). /// diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 0ed9dc1a3e4..5dcc55efc94 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -71,7 +71,7 @@ type Item = | UnionCaseField of UnionCaseInfo * fieldIndex: int /// Represents the resolution of a name to a field of an anonymous record type. - | AnonRecdField of AnonRecdTypeInfo * TTypes * int * range + | AnonRecdField of anonInfo: AnonRecdTypeInfo * tys: TTypes * fieldIndex: int * range: range // The following are never in the items table but are valid results of binding // an identifier in different circumstances. @@ -763,7 +763,7 @@ val internal ResolveNestedField: ad: AccessorDomain -> recdTy: TType -> lid: Ident list -> - Ident list * (Ident * AnonRecdTypeInfo option) list + Ident list * (Ident * Item) list /// Resolve a long identifier occurring in an expression position val internal ResolveExprLongIdent: diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 1ccd4495d89..9df7ef4cdd6 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -670,7 +670,7 @@ type internal TypeCheckInfo None | id :: rest -> match fields |> List.tryFind (fun f -> f.LogicalName = id) with - | Some f -> dive f.RecdField.FormalType denv ad m rest true wasPathEmpty + | Some f -> dive f.FieldType denv ad m rest true wasPathEmpty | _ -> // Field name can be optionally qualified. // If we haven't matched a field name yet, keep peeling off the prefix. diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 9f98d3d35f1..18a8b208fbf 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -824,4 +824,117 @@ let f (r: {| A: int; C: int |}) = | :? FSharpField as f when f.IsAnonRecordField -> true | _ -> false) - Assert.AreEqual(5, getSymbolUses.Length) \ No newline at end of file + Assert.AreEqual(5, getSymbolUses.Length) + + [] + let ``Symbols for fields in nested copy-and-update are present`` () = + let _, checkResults = getParseAndCheckResults """ +type RecordA<'a> = { Foo: 'a; Bar: int; Zoo: RecordA<'a> } + +let nestedFunc (a: RecordA) = { a with Zoo.Foo = 1; Zoo.Zoo.Bar = 2; Zoo.Bar = 3; Foo = 4 } +""" + + let line = "let nestedFunc (a: RecordA) = { a with Zoo.Foo = 1; Zoo.Zoo.Bar = 2; Zoo.Bar = 3; Foo = 4 }" + + let fieldSymbolUse = + checkResults.GetSymbolUsesAtLocation(4, 47, line, [ "Zoo" ]) + |> List.exactlyOne + + match fieldSymbolUse.Symbol with + | :? FSharpField as field -> + Assert.AreEqual ("Zoo", field.Name) + Assert.AreEqual ("RecordA`1", field.DeclaringEntity.Value.CompiledName) + assertRange (4, 44) (4, 47) fieldSymbolUse.Range + + | _ -> Assert.Fail "Symbol was not FSharpField" + + + let fieldSymbolUse = + checkResults.GetSymbolUsesAtLocation(4, 51, line, [ "Foo" ]) + |> List.exactlyOne + + match fieldSymbolUse.Symbol with + | :? FSharpField as field -> + Assert.AreEqual ("Foo", field.Name) + Assert.AreEqual ("RecordA`1", field.DeclaringEntity.Value.CompiledName) + assertRange (4, 48) (4, 51) fieldSymbolUse.Range + + | _ -> Assert.Fail "Symbol was not FSharpField" + + + let fieldSymbolUse = + checkResults.GetSymbolUsesAtLocation(4, 60, line, [ "Zoo" ]) + |> List.exactlyOne + + match fieldSymbolUse.Symbol with + | :? FSharpField as field -> + Assert.AreEqual ("Zoo", field.Name) + Assert.AreEqual ("RecordA`1", field.DeclaringEntity.Value.CompiledName) + assertRange (4, 57) (4, 60) fieldSymbolUse.Range + + | _ -> Assert.Fail "Symbol was not FSharpField" + + + let fieldSymbolUse = + checkResults.GetSymbolUsesAtLocation(4, 64, line, [ "Zoo" ]) + |> List.exactlyOne + + match fieldSymbolUse.Symbol with + | :? FSharpField as field -> + Assert.AreEqual ("Zoo", field.Name) + Assert.AreEqual ("RecordA`1", field.DeclaringEntity.Value.CompiledName) + assertRange (4, 61) (4, 64) fieldSymbolUse.Range + + | _ -> Assert.Fail "Symbol was not FSharpField" + + + let fieldSymbolUse = + checkResults.GetSymbolUsesAtLocation(4, 68, line, [ "Bar" ]) + |> List.exactlyOne + + match fieldSymbolUse.Symbol with + | :? FSharpField as field -> + Assert.AreEqual ("Bar", field.Name) + Assert.AreEqual ("RecordA`1", field.DeclaringEntity.Value.CompiledName) + assertRange (4, 65) (4, 68) fieldSymbolUse.Range + + | _ -> Assert.Fail "Symbol was not FSharpField" + + + let fieldSymbolUse = + checkResults.GetSymbolUsesAtLocation(4, 77, line, [ "Zoo" ]) + |> List.exactlyOne + + match fieldSymbolUse.Symbol with + | :? FSharpField as field -> + Assert.AreEqual ("Zoo", field.Name) + Assert.AreEqual ("RecordA`1", field.DeclaringEntity.Value.CompiledName) + assertRange (4, 74) (4, 77) fieldSymbolUse.Range + + | _ -> Assert.Fail "Symbol was not FSharpField" + + + let fieldSymbolUse = + checkResults.GetSymbolUsesAtLocation(4, 81, line, [ "Bar" ]) + |> List.exactlyOne + + match fieldSymbolUse.Symbol with + | :? FSharpField as field -> + Assert.AreEqual ("Bar", field.Name) + Assert.AreEqual ("RecordA`1", field.DeclaringEntity.Value.CompiledName) + assertRange (4, 78) (4, 81) fieldSymbolUse.Range + + | _ -> Assert.Fail "Symbol was not FSharpField" + + + let fieldSymbolUse = + checkResults.GetSymbolUsesAtLocation(4, 90, line, [ "Foo" ]) + |> List.exactlyOne + + match fieldSymbolUse.Symbol with + | :? FSharpField as field -> + Assert.AreEqual ("Foo", field.Name) + Assert.AreEqual ("RecordA`1", field.DeclaringEntity.Value.CompiledName) + assertRange (4, 87) (4, 90) fieldSymbolUse.Range + + | _ -> Assert.Fail "Symbol was not FSharpField" \ No newline at end of file diff --git a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs index 7003a97b42a..f606ef4cf35 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs @@ -1576,6 +1576,19 @@ let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = "a"; D.B = [ "B"; "C" ] ) + [] + let ``Completion list for nested copy and update contains correct record fields, nominal, recursive, generic`` () = + let fileContents = + """ +type RecordA<'a> = { Foo: 'a; Bar: int; Zoo: RecordA<'a> } + +let fz (a: RecordA) = { a with Zoo.F = 1; Zoo.Zoo.B = 2; F } +""" + + VerifyCompletionListExactly(fileContents, "with Zoo.F", [ "Bar"; "Foo"; "Zoo" ]) + VerifyCompletionListExactly(fileContents, "Zoo.Zoo.B", [ "Bar"; "Foo"; "Zoo" ]) + VerifyCompletionListExactly(fileContents, "; F", [ "Bar"; "Foo"; "Zoo" ]) + [] let ``Anonymous record fields have higher priority than methods`` () = let fileContents =