From 698c4f1ddfab36daab4b5f4854a966ea686fa3ca Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 27 Jul 2023 20:34:00 +0200 Subject: [PATCH 1/2] Report merged identifiers in copy-and-update to the sink --- src/Compiler/Checking/CheckExpressions.fs | 20 ++++---- src/Compiler/Checking/CheckExpressions.fsi | 2 +- src/Compiler/Checking/CheckPatterns.fs | 2 +- .../Checking/CheckRecordSyntaxHelpers.fs | 50 +++++++++++++------ .../Checking/CheckRecordSyntaxHelpers.fsi | 9 +++- src/Compiler/Checking/NameResolution.fs | 34 +++++++------ src/Compiler/Checking/NameResolution.fsi | 2 +- 7 files changed, 74 insertions(+), 45 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 489456fe02..1a9a5d2684 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1801,7 +1801,7 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = //------------------------------------------------------------------------- /// Helper used to check record expressions and record patterns -let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * 'T) list) m = +let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * 'U * 'T) list) m = let g = cenv.g let ad = env.eAccessRights @@ -1810,9 +1810,9 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' let fldCount = flds.Length let fldResolutions = - let allFields = flds |> List.map (fun ((_, ident), _) -> ident) + let allFields = flds |> List.map (fun ((_, ident), _, _) -> ident) flds - |> List.choose (fun (fld, fldExpr) -> + |> List.choose (fun (fld, _, fldExpr) -> try let fldPath, fldId = fld let frefSet = ResolveField cenv.tcSink cenv.nameResolver env.eNameResEnv ad ty fldPath fldId allFields @@ -7378,11 +7378,11 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m raise (ReportedError None) match withExprOpt, synLongId.LongIdent, exprBeingAssigned with - | _, [ id ], _ -> ([], id), exprBeingAssigned + | _, [ id ], _ -> ([], id), None, exprBeingAssigned | Some withExpr, lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr - | _ -> List.frontAndBack synLongId.LongIdent, exprBeingAssigned) + | _ -> List.frontAndBack synLongId.LongIdent, None, exprBeingAssigned) - let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds + let flds = if hasOrigExpr then GroupUpdatesToNestedFields cenv.tcSink env.NameEnv env.AccessRights flds else flds match flds with | [] -> [] @@ -7528,11 +7528,11 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or |> List.map (fun (synLongIdent, _, exprBeingAssigned) -> match synLongIdent.LongIdent with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), mWholeExpr)) - | [ id ] -> ([], id), Some exprBeingAssigned + | [ id ] -> ([], id), None, Some exprBeingAssigned | lid -> TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)) - |> GroupUpdatesToNestedFields + |> GroupUpdatesToNestedFields cenv.tcSink env.NameEnv env.AccessRights - let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.choose snd + let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.choose p33 let origExprIsStruct = match tryDestAnonRecdTy g origExprTy with @@ -7549,7 +7549,7 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or /// - Choice2Of2 for a binding coming from the original expression let unsortedIdAndExprsAll = [| - for (_, id), e in unsortedFieldIdsAndSynExprsGiven do + for (_, id), _, e in unsortedFieldIdsAndSynExprsGiven do yield (id, Choice1Of2 e) match tryDestAnonRecdTy g origExprTy with | ValueSome (anonInfo, tinst) -> diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index b26381b6b0..5caa57ea3b 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -893,7 +893,7 @@ val BuildFieldMap: env: TcEnv -> isPartial: bool -> ty: TType -> - flds: ((Ident list * Ident) * 'T) list -> + flds: ((Ident list * Ident) * 'U * 'T) list -> m: range -> (TypeInst * TyconRef * Map * (string * 'T) list) option diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 16e082f551..b454a73e4e 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -440,7 +440,7 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m = phase2, acc and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m = - let fieldPats = fieldPats |> List.map (fun (fieldId, _, fieldPat) -> fieldId, fieldPat) + let fieldPats = fieldPats |> List.map (fun (fieldId, _, fieldPat) -> fieldId, None, fieldPat) match BuildFieldMap cenv env true ty fieldPats m with | None -> (fun _ -> TPat_error m), patEnv | Some(tinst, tcref, fldsmap, _fldsList) -> diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs index da63423964..ef4a59552d 100644 --- a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs @@ -11,6 +11,7 @@ open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree +open Internal.Utilities.Library.Extras /// Merges updates to nested record fields on the same level in record copy-and-update. /// @@ -26,27 +27,50 @@ open FSharp.Compiler.TypedTree /// which we here convert to /// /// { x with A = { x.A with B = 10; C = "" } } -let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = +let GroupUpdatesToNestedFields sink nenv ad (fields: ((Ident list * Ident) * Item option * SynExpr option) list) = let rec groupIfNested res xs = match xs with | [] -> res | x :: [] -> x :: res | x :: y :: ys -> + // Merging { x with A = { x.A with B = 10 }; A = { x.A with C = "" } } into { x with A = { x.A with B = 10; C = "" } } + // ^ + // | + // ------- + // | + // { x with A.B = 10; A.C = "" } | + // ^ | + // | | + // ------------ | + // | | + // ______________ _______________ + // We're losing track of the original range of this identifier after this point, + // so report it to the name resolution environment match x, y with - | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (_, Some (SynExpr.Record (recordFields = bFlds))) -> + | (lidwid, item, Some (SynExpr.Record (baseInfo, copyInfo, fields1, m1))), + (_, _, Some (SynExpr.Record (recordFields = fields2; range = m2))) -> let reducedRecd = - (lidwid, Some(SynExpr.Record(baseInfo, copyInfo, aFlds @ bFlds, m))) + (lidwid, item, Some(SynExpr.Record(baseInfo, copyInfo, fields1 @ fields2, m1.MakeSynthetic()))) + + match item with + | Some item -> CallNameResolutionSink sink (m2, nenv, item, [], ItemOccurence.Use, ad) + | _ -> () groupIfNested res (reducedRecd :: ys) - | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (_, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> + | (lidwid, item, Some (SynExpr.AnonRecd (isStruct, copyInfo, fields1, m1, trivia))), + (_, _, Some (SynExpr.AnonRecd (recordFields = fields2; range = m2))) -> let reducedRecd = - (lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, aFlds @ bFlds, m, trivia))) + (lidwid, item, Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1 @ fields2, m1.MakeSynthetic(), trivia))) + + match item with + | Some item -> CallNameResolutionSink sink (m2, nenv, item, [], ItemOccurence.Use, ad) + | _ -> () groupIfNested res (reducedRecd :: ys) | _ -> groupIfNested (x :: res) (y :: ys) fields - |> List.groupBy (fun ((_, field), _) -> field.idText) + |> List.groupBy (fun ((_, field), _, _) -> field.idText) |> List.collect (fun (_, fields) -> if fields.Length < 2 then fields @@ -105,36 +129,34 @@ let TransformAstForNestedUpdates (cenv: TcFileState) env overallTy (lid: LongIde let rec synExprRecd copyInfo (id: Ident) fields exprBeingAssigned = match fields with | [] -> failwith "unreachable" - | (fieldId, anonInfo) :: rest -> + | (fieldId, anonInfo, _) :: rest -> 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 } -> let fields = [ LongIdentWithDots([ fieldId ], []), None, nestedField ] - SynExpr.AnonRecd(isStruct, copyInfo id, fields, m, { OpeningBraceRange = range0 }) + SynExpr.AnonRecd(isStruct, copyInfo id, fields, id.idRange, { OpeningBraceRange = range0 }) | _ -> let fields = [ SynExprRecordField((LongIdentWithDots([ fieldId ], []), true), None, Some nestedField, None) ] - SynExpr.Record(None, copyInfo id, fields, m) + SynExpr.Record(None, copyInfo id, fields, id.idRange) let access, fields = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid match access, fields with | _, [] -> failwith "unreachable" - | accessIds, [ (fieldId, _) ] -> (accessIds, fieldId), Some exprBeingAssigned - | accessIds, (fieldId, _) :: rest -> + | accessIds, [ (fieldId, _, item) ] -> (accessIds, fieldId), item, Some exprBeingAssigned + | accessIds, (fieldId, _, item) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) - (accessIds, fieldId), Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) fieldId rest exprBeingAssigned) + (accessIds, fieldId), item, Some(synExprRecd (recdExprCopyInfo (fields |> List.map p13) withExpr) fieldId rest exprBeingAssigned) diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi index b4eb4bc994..d22395dfc8 100644 --- a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi @@ -3,12 +3,17 @@ 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 val GroupUpdatesToNestedFields: - fields: ((Ident list * Ident) * SynExpr option) list -> ((Ident list * Ident) * SynExpr option) list + sink: TcResultsSink -> + nenv: NameResolutionEnv -> + ad: AccessibilityLogic.AccessorDomain -> + fields: ((Ident list * Ident) * Item option * SynExpr option) list -> + ((Ident list * Ident) * Item option * SynExpr option) list val TransformAstForNestedUpdates<'a> : cenv: TcFileState -> @@ -17,4 +22,4 @@ val TransformAstForNestedUpdates<'a> : lid: LongIdent -> exprBeingAssigned: SynExpr -> withExpr: SynExpr * (range * 'a) -> - (Ident list * Ident) * SynExpr option + (Ident list * Ident) * Item option * SynExpr option diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index ddc906290b..fab8b855d0 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3746,7 +3746,8 @@ 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), Choice2Of2 (anonInfo, tys[index])) | _ -> raze (Error(FSComp.SR.nrRecordDoesNotContainSuchLabel(NicePrint.minimalStringOfType nenv.eDisplayEnv ty, id.idText), m)) | _ -> let otherRecordFields ty = @@ -3761,7 +3762,8 @@ 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 (RecdFieldInfo (_, rfref) as info) -> + OneSuccess (Item.RecdField info, Choice1Of2 rfref) | _ -> // record label doesn't belong to record type -> suggest other labels of same record let suggestLabels addToBuffer = @@ -3777,7 +3779,7 @@ 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 (RecdFieldInfo (emptyTypeInst, rfref)), Choice1Of2 rfref) |> success | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecordFields ty)) @@ -3792,7 +3794,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let res = lookupField recdTy id |> ForceRaise - |> List.map (fun x -> id, anonRecdInfoF x) + |> List.map (fun (item, ref) -> id, anonRecdInfoF ref, Some item) [], res | id :: _ -> @@ -3800,10 +3802,10 @@ 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 (item, ref) -> + match ref with + | Choice1Of2 rfref -> None, id, rfref.RecdField.FormalType, Some item, rest + | Choice2Of2 (anonInfo, fldTy) -> Some anonInfo, id, fldTy, Some item, rest) | _ -> NoResultsOrUsefulErrors let tyconSearch ad () = @@ -3819,7 +3821,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 (RecdFieldInfo (_, rfref) as info), rest -> Some (None, fieldId, rfref.RecdField.FormalType, Some (Item.RecdField info), rest) | _ -> None) | _ -> NoResultsOrUsefulErrors @@ -3830,9 +3832,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) + None, fieldId, rfinfo.RecdField.FormalType, Some (Item.RecdField rfinfo), restAfterField) - let anonRecdInfo, fieldId, fieldTy, rest = + let anonRecdInfo, fieldId, fieldTy, item, rest = let search = if isAnonRecdTy then fieldSearch () @@ -3850,7 +3852,7 @@ 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, anonRecdInfo, item) ] | _ -> let rec nestedFieldSearch fields ty lid = match lid with @@ -3859,15 +3861,15 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let resolved = lookupField ty id |> ForceRaise let fieldTy = match resolved with - | [ Choice1Of2 rfref ] -> rfref.RecdField.FormalType - | [ Choice2Of2 (_, fieldTy) ] -> fieldTy + | [ _, Choice1Of2 rfref ] -> rfref.RecdField.FormalType + | [ _, Choice2Of2 (_, fieldTy) ] -> fieldTy | _ -> ty - let resolved = resolved |> List.map (fun x -> id, anonRecdInfoF x) + let resolved = resolved |> List.map (fun (item, ref) -> id, anonRecdInfoF ref, Some item) nestedFieldSearch (fields @ resolved) fieldTy rest - idsBeforeField, (fieldId, anonRecdInfo) :: (nestedFieldSearch [] fieldTy rest) + idsBeforeField, (fieldId, anonRecdInfo, 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 0ed9dc1a3e..b68c753a45 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -763,7 +763,7 @@ val internal ResolveNestedField: ad: AccessorDomain -> recdTy: TType -> lid: Ident list -> - Ident list * (Ident * AnonRecdTypeInfo option) list + Ident list * (Ident * AnonRecdTypeInfo option * Item option) list /// Resolve a long identifier occurring in an expression position val internal ResolveExprLongIdent: From 5a9e3707e2897de9443865b5b6238be0fda6540d Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 29 Jul 2023 15:37:30 +0200 Subject: [PATCH 2/2] Fix, add tests --- src/Compiler/Checking/CheckExpressions.fs | 20 ++-- src/Compiler/Checking/CheckExpressions.fsi | 2 +- src/Compiler/Checking/CheckPatterns.fs | 2 +- .../Checking/CheckRecordSyntaxHelpers.fs | 74 +++++------- .../Checking/CheckRecordSyntaxHelpers.fsi | 8 +- src/Compiler/Checking/NameResolution.fs | 51 ++++---- src/Compiler/Checking/NameResolution.fsi | 4 +- src/Compiler/Service/FSharpCheckerResults.fs | 2 +- tests/service/Symbols.fs | 113 ++++++++++++++++++ .../CompletionProviderTests.fs | 13 ++ 10 files changed, 196 insertions(+), 93 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 1a9a5d2684..489456fe02 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1801,7 +1801,7 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = //------------------------------------------------------------------------- /// Helper used to check record expressions and record patterns -let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * 'U * 'T) list) m = +let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * 'T) list) m = let g = cenv.g let ad = env.eAccessRights @@ -1810,9 +1810,9 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' let fldCount = flds.Length let fldResolutions = - let allFields = flds |> List.map (fun ((_, ident), _, _) -> ident) + let allFields = flds |> List.map (fun ((_, ident), _) -> ident) flds - |> List.choose (fun (fld, _, fldExpr) -> + |> List.choose (fun (fld, fldExpr) -> try let fldPath, fldId = fld let frefSet = ResolveField cenv.tcSink cenv.nameResolver env.eNameResEnv ad ty fldPath fldId allFields @@ -7378,11 +7378,11 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m raise (ReportedError None) match withExprOpt, synLongId.LongIdent, exprBeingAssigned with - | _, [ id ], _ -> ([], id), None, exprBeingAssigned + | _, [ id ], _ -> ([], id), exprBeingAssigned | Some withExpr, lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr - | _ -> List.frontAndBack synLongId.LongIdent, None, exprBeingAssigned) + | _ -> List.frontAndBack synLongId.LongIdent, exprBeingAssigned) - let flds = if hasOrigExpr then GroupUpdatesToNestedFields cenv.tcSink env.NameEnv env.AccessRights flds else flds + let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds match flds with | [] -> [] @@ -7528,11 +7528,11 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or |> List.map (fun (synLongIdent, _, exprBeingAssigned) -> match synLongIdent.LongIdent with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), mWholeExpr)) - | [ id ] -> ([], id), None, Some exprBeingAssigned + | [ id ] -> ([], id), Some exprBeingAssigned | lid -> TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)) - |> GroupUpdatesToNestedFields cenv.tcSink env.NameEnv env.AccessRights + |> GroupUpdatesToNestedFields - let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.choose p33 + let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.choose snd let origExprIsStruct = match tryDestAnonRecdTy g origExprTy with @@ -7549,7 +7549,7 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or /// - Choice2Of2 for a binding coming from the original expression let unsortedIdAndExprsAll = [| - for (_, id), _, e in unsortedFieldIdsAndSynExprsGiven do + for (_, id), e in unsortedFieldIdsAndSynExprsGiven do yield (id, Choice1Of2 e) match tryDestAnonRecdTy g origExprTy with | ValueSome (anonInfo, tinst) -> diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 5caa57ea3b..b26381b6b0 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -893,7 +893,7 @@ val BuildFieldMap: env: TcEnv -> isPartial: bool -> ty: TType -> - flds: ((Ident list * Ident) * 'U * 'T) list -> + flds: ((Ident list * Ident) * 'T) list -> m: range -> (TypeInst * TyconRef * Map * (string * 'T) list) option diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index b454a73e4e..16e082f551 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -440,7 +440,7 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m = phase2, acc and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m = - let fieldPats = fieldPats |> List.map (fun (fieldId, _, fieldPat) -> fieldId, None, fieldPat) + let fieldPats = fieldPats |> List.map (fun (fieldId, _, fieldPat) -> fieldId, fieldPat) match BuildFieldMap cenv env true ty fieldPats m with | None -> (fun _ -> TPat_error m), patEnv | Some(tinst, tcref, fldsmap, _fldsList) -> diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs index ef4a59552d..5665e13457 100644 --- a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs @@ -11,7 +11,6 @@ open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree -open Internal.Utilities.Library.Extras /// Merges updates to nested record fields on the same level in record copy-and-update. /// @@ -27,50 +26,28 @@ open Internal.Utilities.Library.Extras /// which we here convert to /// /// { x with A = { x.A with B = 10; C = "" } } -let GroupUpdatesToNestedFields sink nenv ad (fields: ((Ident list * Ident) * Item option * SynExpr option) list) = +let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = let rec groupIfNested res xs = match xs with | [] -> res | x :: [] -> x :: res | x :: y :: ys -> - // Merging { x with A = { x.A with B = 10 }; A = { x.A with C = "" } } into { x with A = { x.A with B = 10; C = "" } } - // ^ - // | - // ------- - // | - // { x with A.B = 10; A.C = "" } | - // ^ | - // | | - // ------------ | - // | | - // ______________ _______________ - // We're losing track of the original range of this identifier after this point, - // so report it to the name resolution environment match x, y with - | (lidwid, item, Some (SynExpr.Record (baseInfo, copyInfo, fields1, m1))), - (_, _, Some (SynExpr.Record (recordFields = fields2; range = m2))) -> + | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, fields1, m))), (_, Some (SynExpr.Record (recordFields = fields2))) -> let reducedRecd = - (lidwid, item, Some(SynExpr.Record(baseInfo, copyInfo, fields1 @ fields2, m1.MakeSynthetic()))) - - match item with - | Some item -> CallNameResolutionSink sink (m2, nenv, item, [], ItemOccurence.Use, ad) - | _ -> () + (lidwid, Some(SynExpr.Record(baseInfo, copyInfo, fields1 @ fields2, m))) groupIfNested res (reducedRecd :: ys) - | (lidwid, item, Some (SynExpr.AnonRecd (isStruct, copyInfo, fields1, m1, trivia))), - (_, _, Some (SynExpr.AnonRecd (recordFields = fields2; range = m2))) -> + | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, fields1, m, trivia))), + (_, Some (SynExpr.AnonRecd (recordFields = fields2))) -> let reducedRecd = - (lidwid, item, Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1 @ fields2, m1.MakeSynthetic(), trivia))) - - match item with - | Some item -> CallNameResolutionSink sink (m2, nenv, item, [], ItemOccurence.Use, ad) - | _ -> () + (lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1 @ fields2, m, trivia))) groupIfNested res (reducedRecd :: ys) | _ -> groupIfNested (x :: res) (y :: ys) fields - |> List.groupBy (fun ((_, field), _, _) -> field.idText) + |> List.groupBy (fun ((_, field), _) -> field.idText) |> List.collect (fun (_, fields) -> if fields.Length < 2 then fields @@ -79,8 +56,8 @@ let GroupUpdatesToNestedFields sink nenv ad (fields: ((Ident list * Ident) * Ite /// 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) = @@ -126,37 +103,46 @@ 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 - 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, id.idRange, { 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, id.idRange) + SynExpr.Record(None, copyInfo outerFieldId, fields, outerFieldId.idRange) let access, fields = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid match access, fields with | _, [] -> failwith "unreachable" - | accessIds, [ (fieldId, _, item) ] -> (accessIds, fieldId), item, Some exprBeingAssigned - | accessIds, (fieldId, _, item) :: rest -> + | accessIds, [ (fieldId, _) ] -> (accessIds, fieldId), Some exprBeingAssigned + | accessIds, (outerFieldId, item) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) - (accessIds, fieldId), item, Some(synExprRecd (recdExprCopyInfo (fields |> List.map p13) 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 d22395dfc8..f239c82436 100644 --- a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi @@ -9,11 +9,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree val GroupUpdatesToNestedFields: - sink: TcResultsSink -> - nenv: NameResolutionEnv -> - ad: AccessibilityLogic.AccessorDomain -> - fields: ((Ident list * Ident) * Item option * SynExpr option) list -> - ((Ident list * Ident) * Item option * SynExpr option) list + fields: ((Ident list * Ident) * SynExpr option) list -> ((Ident list * Ident) * SynExpr option) list val TransformAstForNestedUpdates<'a> : cenv: TcFileState -> @@ -22,4 +18,4 @@ val TransformAstForNestedUpdates<'a> : lid: LongIdent -> exprBeingAssigned: SynExpr -> withExpr: SynExpr * (range * 'a) -> - (Ident list * Ident) * Item option * SynExpr option + (Ident list * Ident) * SynExpr option diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index fab8b855d0..7ebcb2bfa9 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. @@ -3746,8 +3746,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 (Item.AnonRecdField (anonInfo, tys, index, m), 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 = @@ -3762,8 +3761,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) as info) -> - OneSuccess (Item.RecdField info, 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 = @@ -3779,22 +3777,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 (fun rfref -> Item.RecdField (RecdFieldInfo (emptyTypeInst, rfref)), Choice1Of2 rfref) + |> 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 (item, ref) -> id, anonRecdInfoF ref, Some item) + |> List.map (fun x -> id, x) [], res | id :: _ -> @@ -3802,10 +3795,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = match lid with | id :: rest -> lookupField recdTy id - |?> List.map (fun (item, ref) -> - match ref with - | Choice1Of2 rfref -> None, id, rfref.RecdField.FormalType, Some item, rest - | Choice2Of2 (anonInfo, fldTy) -> Some anonInfo, id, fldTy, Some item, rest) + |?> List.map (fun x -> id, x, rest) | _ -> NoResultsOrUsefulErrors let tyconSearch ad () = @@ -3821,7 +3811,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) as info), rest -> Some (None, fieldId, rfref.RecdField.FormalType, Some (Item.RecdField info), rest) + | _, (Item.RecdField _ as item), rest -> Some (fieldId, item, rest) | _ -> None) | _ -> NoResultsOrUsefulErrors @@ -3832,9 +3822,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, Some (Item.RecdField rfinfo), restAfterField) + fieldId, Item.RecdField rfinfo, restAfterField) - let anonRecdInfo, fieldId, fieldTy, item, rest = + let fieldId, item, rest = let search = if isAnonRecdTy then fieldSearch () @@ -3852,24 +3842,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, item) ] + | [] -> 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 (item, ref) -> id, anonRecdInfoF ref, Some item) + | [ 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, item) :: (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 b68c753a45..5dcc55efc9 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 * Item 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 1ccd4495d8..9df7ef4cdd 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 6dbfd2bbaf..77db08375d 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -751,3 +751,116 @@ type Foo() = and set (a: int) (b: float) = () """ (5, 14, " member _.X", "X") + + [] + 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 7003a97b42..f606ef4cf3 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 =