diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index c7dee26d748..a1cb3b8063b 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -16,8 +16,8 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CheckBasics +open FSharp.Compiler.CheckRecordSyntaxHelpers open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features @@ -6568,7 +6568,9 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) env tpenv withExprInfoO if not (Zset.subset ns2 ns1) then error(MissingFields(Zset.elements (Zset.diff ns2 ns1), m)) | _ -> - if oldFldsList.IsEmpty then + // `TransformAstForNestedUpdates` creates record constructions with synthetic ranges. + // Don't emit the warning for nested field updates, because it does not really make sense. + if oldFldsList.IsEmpty && not m.IsSynthetic then let enabledByLangFeature = g.langVersion.SupportsFeature LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields warning(ErrorEnabledWithLanguageFeature(FSComp.SR.tcCopyAndUpdateRecordChangesAllFields(fullDisplayTextOfTyconRef tcref), m, enabledByLangFeature)) @@ -7294,37 +7296,40 @@ and TcAssertExpr cenv overallTy env (m: range) tpenv x = TcExpr cenv overallTy env tpenv callDiagnosticsExpr -and TcRecdExpr cenv (overallTy: TType) env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr) = - +and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr) = let g = cenv.g let requiresCtor = (GetCtorShapeCounter env = 1) // Get special expression forms for constructors let haveCtor = Option.isSome inherits - let withExprOpt, tpenv = - match withExprOpt with - | None -> None, tpenv - | Some (origExpr, _) -> - match inherits with - | Some (_, _, mInherits, _, _) -> error(Error(FSComp.SR.tcInvalidRecordConstruction(), mInherits)) - | None -> - let withExpr, tpenv = TcExpr cenv (MustEqual overallTy) env tpenv origExpr - Some withExpr, tpenv + let withExprOptChecked, tpenv = + match withExprOpt with + | None -> None, tpenv + | Some (origExpr, _) -> + match inherits with + | Some (_, _, mInherits, _, _) -> error(Error(FSComp.SR.tcInvalidRecordConstruction(), mInherits)) + | None -> + let withExpr, tpenv = TcExpr cenv (MustEqual overallTy) env tpenv origExpr + Some withExpr, tpenv - let hasOrigExpr = withExprOpt.IsSome + let hasOrigExpr = withExprOptChecked.IsSome let fldsList = let flds = - [ + synRecdFields + |> List.map (fun (SynExprRecordField (fieldName = (synLongId, isOk); expr = exprBeingAssigned)) -> // if we met at least one field that is not syntactically correct - raise ReportedError to transfer control to the recovery routine - for SynExprRecordField(fieldName=(synLongId, isOk); expr=v) in synRecdFields do - if not isOk then - // raising ReportedError None transfers control to the closest errorRecovery point but do not make any records into log - // we assume that parse errors were already reported - raise (ReportedError None) + if not isOk then + // raising ReportedError None transfers control to the closest errorRecovery point but do not make any records into log + // we assume that parse errors were already reported + raise (ReportedError None) - yield (List.frontAndBack synLongId.LongIdent, v) - ] + match withExprOpt, synLongId.LongIdent, exprBeingAssigned with + | _, [ id ], _ -> ([], id), exprBeingAssigned + | Some withExpr, lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr + | _ -> List.frontAndBack synLongId.LongIdent, exprBeingAssigned) + + let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds match flds with | [] -> [] @@ -7339,7 +7344,7 @@ and TcRecdExpr cenv (overallTy: TType) env tpenv (inherits, withExprOpt, synRecd | None -> () ] let withExprInfoOpt = - match withExprOpt with + match withExprOptChecked with | None -> None | Some withExpr -> let withExprAddrVal, withExprAddrValExpr = mkCompGenLocal mWholeExpr "inputRecord" (if isStructTy g overallTy then mkByrefTy g overallTy else overallTy) @@ -7393,7 +7398,7 @@ and TcAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, optOrigSynExpr, // Check for duplicate field IDs unsortedFieldIdsAndSynExprsGiven - |> List.countBy (fun (fId, _, _) -> fId.idText) + |> List.countBy (fun (fId, _, _) -> textOfLid fId.LongIdent) |> List.iter (fun (label, count) -> if count > 1 then error (Error (FSComp.SR.tcAnonRecdDuplicateFieldId(label), mWholeExpr))) @@ -7401,14 +7406,14 @@ and TcAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, optOrigSynExpr, | None -> TcNewAnonRecdExpr cenv overallTy env tpenv (isStruct, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) - | Some (origExpr, _) -> - TcCopyAndUpdateAnonRecdExpr cenv overallTy env tpenv (isStruct, origExpr, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) + | Some orig -> + TcCopyAndUpdateAnonRecdExpr cenv overallTy env tpenv (isStruct, orig, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) = let g = cenv.g let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (_, _, fieldExpr) -> fieldExpr) - let unsortedFieldIds = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (fieldId, _, _) -> fieldId) |> List.toArray + let unsortedFieldIds = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (synLongIdent, _, _) -> synLongIdent.LongIdent[0]) |> List.toArray let anonInfo, sortedFieldTys = UnifyAnonRecdTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv mWholeExpr overallTy isStruct unsortedFieldIds // Sort into canonical order @@ -7421,9 +7426,10 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField let sigma = sortedIndexedArgs |> List.map fst |> List.toArray let sortedFieldExprs = sortedIndexedArgs |> List.map snd - sortedFieldExprs |> List.iteri (fun j (fieldId, _, _) -> - let item = Item.AnonRecdField(anonInfo, sortedFieldTys, j, fieldId.idRange) - CallNameResolutionSink cenv.tcSink (fieldId.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights)) + sortedFieldExprs |> List.iteri (fun j (synLongIdent, _, _) -> + let m = rangeOfLid synLongIdent.LongIdent + let item = Item.AnonRecdField(anonInfo, sortedFieldTys, j, m) + CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights)) let unsortedFieldTys = sortedFieldTys @@ -7437,7 +7443,7 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField mkAnonRecd g mWholeExpr anonInfo unsortedFieldIds unsortedCheckedArgs unsortedFieldTys, tpenv -and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, origExpr, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) = +and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (origExpr, blockSeparator), unsortedFieldIdsAndSynExprsGiven, mWholeExpr) = // The fairly complex case '{| origExpr with X = 1; Y = 2 |}' // The origExpr may be either a record or anonymous record. // The origExpr may be either a struct or not. @@ -7448,7 +7454,6 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, ori // Unlike in the case of record type copy-and-update {| a with X = 1 |} does not force a.X to exist or have had type 'int' let g = cenv.g - let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (_, _, e) -> e) let origExprTy = NewInferenceType g let origExprChecked, tpenv = TcExpr cenv (MustEqual origExprTy) env tpenv origExpr let oldv, oldve = mkCompGenLocal mWholeExpr "inputRecord" origExprTy @@ -7457,6 +7462,18 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, ori if not (isAppTy g origExprTy || isAnonRecdTy g origExprTy) then error (Error (FSComp.SR.tcCopyAndUpdateNeedsRecordType(), mOrigExpr)) + // Expand expressions with respect to potential nesting + let unsortedFieldIdsAndSynExprsGiven = + unsortedFieldIdsAndSynExprsGiven + |> List.map (fun (synLongIdent, _, exprBeingAssigned) -> + match synLongIdent.LongIdent with + | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), mWholeExpr)) + | [ id ] -> ([], id), Some exprBeingAssigned + | lid -> TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)) + |> GroupUpdatesToNestedFields + + let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.choose snd + let origExprIsStruct = match tryDestAnonRecdTy g origExprTy with | ValueSome (anonInfo, _) -> evalTupInfoIsStruct anonInfo.TupInfo @@ -7472,7 +7489,7 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, ori /// - 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 0e079eeec33..f3e9ad559d4 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -892,7 +892,7 @@ val BuildFieldMap: env: TcEnv -> isPartial: bool -> ty: TType -> - ((Ident list * Ident) * 'T) list -> + flds: ((Ident list * Ident) * 'T) list -> m: range -> TypeInst * TyconRef * Map * (string * 'T) list diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs new file mode 100644 index 00000000000..a8dd41f1eaf --- /dev/null +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs @@ -0,0 +1,140 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.CheckRecordSyntaxHelpers + +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Features +open FSharp.Compiler.NameResolution +open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTreeOps +open FSharp.Compiler.Text.Position +open FSharp.Compiler.Text.Range +open FSharp.Compiler.TypedTree + +/// Merges updates to nested record fields on the same level in record copy-and-update. +/// +/// `TransformAstForNestedUpdates` expands `{ x with A.B = 10; A.C = "" }` +/// +/// into +/// +/// { x with +/// A = { x.A with B = 10 }; +/// A = { x.A with C = "" } +/// } +/// +/// which we here convert to +/// +/// { x with A = { x.A with B = 10; C = "" } } +let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = + let rec groupIfNested res xs = + match xs with + | [] -> res + | x :: [] -> x :: res + | x :: y :: ys -> + match x, y with + | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (_, Some (SynExpr.Record (recordFields = bFlds))) -> + let reducedRecd = + (lidwid, Some(SynExpr.Record(baseInfo, copyInfo, aFlds @ bFlds, m))) + + groupIfNested (reducedRecd :: res) ys + | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (_, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> + let reducedRecd = + (lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, aFlds @ bFlds, m, trivia))) + + groupIfNested (reducedRecd :: res) ys + | _ -> groupIfNested (x :: res) (y :: ys) + + fields + |> List.groupBy (fun ((_, field), _) -> field.idText) + |> List.collect (fun (_, fields) -> + if fields.Length < 2 then + fields + else + groupIfNested [] fields) + +/// 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 = + let recdExprCopyInfo ids withExpr id = + let upToId origSepRng id lidwd = + let rec buildLid res (id: Ident) = + function + | [] -> res + | (h: Ident) :: t -> + // Mark these hidden field accesses as synthetic so that they don't make it + // into the name resolution sink. + let h = ident (h.idText, h.idRange.MakeSynthetic()) + + if equals h.idRange id.idRange then + h :: res + else + buildLid (h :: res) id t + + let calcLidSeparatorRanges origSepRng lid = + match lid with + | [] + | [ _ ] -> [ origSepRng ] + | _ :: t -> + origSepRng + :: List.map (fun (s: Ident, e: Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t + + let lid = buildLid [] id lidwd |> List.rev + + (lid, List.pairwise lid |> calcLidSeparatorRanges origSepRng) + + let totalRange (origId: Ident) (id: Ident) = + mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start + + let rangeOfBlockSeperator (id: Ident) = + let idEnd = id.idRange.End + let blockSeperatorStartCol = idEnd.Column + let blockSeperatorEndCol = blockSeperatorStartCol + 4 + let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol + let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol + + mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos + + match withExpr with + | SynExpr.Ident origId, (sepRange, _) -> + let lid, rng = upToId sepRange id (origId :: ids) + 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 + | [] -> failwith "unreachable" + | (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 }) + | _ -> + let fields = + [ + SynExprRecordField((LongIdentWithDots([ fieldId ], []), true), None, Some nestedField, None) + ] + + SynExpr.Record(None, copyInfo id, fields, m) + + 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 -> + checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) + + (accessIds, fieldId), Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) fieldId rest exprBeingAssigned) diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi new file mode 100644 index 00000000000..b4eb4bc9948 --- /dev/null +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi @@ -0,0 +1,20 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.CheckRecordSyntaxHelpers + +open FSharp.Compiler.CheckBasics +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 + +val TransformAstForNestedUpdates<'a> : + cenv: TcFileState -> + env: TcEnv -> + overallTy: TType -> + lid: LongIdent -> + exprBeingAssigned: SynExpr -> + withExpr: SynExpr * (range * 'a) -> + (Ident list * Ident) * SynExpr option diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 3a5d91cb455..570928368a8 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3692,6 +3692,146 @@ let ResolveField sink ncenv nenv ad ty mp id allFields = ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, checker) rfref) +/// Resolve a long identifier representing a nested record field. +/// +/// Fields in copy-and-update expressions are specified using long identifiers - `{ x with A.B.C.D.E = 0 }`. +/// The name of the field to update may be prefixed by namespaces, modules and record type, and be suffixed by field +/// names of records nested within. Here we split the long identifier into a list of 0 or more identifiers +/// which act as the qualifiers, and a list of 1 or more identifiers which refer to actual record fields. +let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = + let typeNameResInfo = TypeNameResolutionInfo.Default + let g = ncenv.g + let isAnonRecdTy = isAnonRecdTy g recdTy + + let lookupField ty (id: Ident) = + let m = id.idRange + + 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])) + | _ -> raze (Error(FSComp.SR.nrRecordDoesNotContainSuchLabel(NicePrint.minimalStringOfType nenv.eDisplayEnv ty, id.idText), m)) + | _ -> + let otherRecordFields ty = + let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty + + [ + for KeyValue (_, v) in nenv.eFieldLabels do + match v |> List.tryFind (fun r -> r.TyconRef.DisplayName = typeName) with + | Some rfref -> yield rfref.RecdField.Id + | None -> () + ] + + if isRecdTy g ty then + match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with + | ValueSome (RecdFieldInfo (_, rfref)) -> OneSuccess (Choice1Of2 rfref) + | _ -> + // record label doesn't belong to record type -> suggest other labels of same record + let suggestLabels addToBuffer = + for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecordFields ty) do + addToBuffer label + + let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty + let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText) + raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels)) + else + match Map.tryFind id.idText nenv.eFieldLabels with + | Some fields -> + // Eliminate duplicates arising from multiple 'open' + fields + |> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) + |> List.map Choice1Of2 + |> 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) + + [], res + | id :: _ -> + let fieldSearch () = + 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) + | _ -> NoResultsOrUsefulErrors + + let tyconSearch ad () = + match lid with + | tyconId :: fieldId :: rest -> + let tcrefs = + LookupTypeNameInEnvNoArity OpenQualified tyconId.idText nenv + |> List.map (fun tcref -> ResolutionInfo.Empty, tcref) + + if isNil tcrefs then + NoResultsOrUsefulErrors + else + 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) + | _ -> None) + | _ -> NoResultsOrUsefulErrors + + let moduleOrNsSearch ad () = + match lid with + | [] -> NoResultsOrUsefulErrors + | modOrNsId :: rest -> + 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) + + let anonRecdInfo, fieldId, fieldTy, rest = + let search = + if isAnonRecdTy then + fieldSearch () + else + moduleOrNsSearch ad () +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode +++ fieldSearch + + search + |> AtMostOneResult id.idRange + |> ForceRaise + + let idsBeforeField = + if isAnonRecdTy then + [] + else + lid |> List.takeWhile (fun id -> not (equals id.idRange fieldId.idRange)) + + match rest with + | [] -> idsBeforeField, [ (fieldId, anonRecdInfo) ] + | _ -> + let rec nestedFieldSearch fields ty lid = + match lid with + | [] -> fields + | id :: rest -> + let resolved = lookupField ty 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) + + nestedFieldSearch (fields @ resolved) fieldTy rest + + idsBeforeField, (fieldId, anonRecdInfo) :: (nestedFieldSearch [] fieldTy rest) + /// Resolve F#/IL "." syntax in expressions (2). /// /// We have an expr. on the left, and we do an access, e.g. @@ -4698,11 +4838,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( let amap = ncenv.amap match item with - | Item.RecdField _ -> - yield! - ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) - |> List.filter (fun rfref -> rfref.IsStatic = statics && IsFieldInfoAccessible ad rfref) - |> List.map Item.RecdField + | Item.RecdField _ -> yield! ResolveRecordOrClassFieldsOfType ncenv m ad ty statics | Item.UnionCase _ -> if statics then match tryAppTy g ty with diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 6a67054786e..f0eed4a6bb8 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -742,6 +742,16 @@ val internal ResolveField: allFields: Ident list -> FieldResolution list +/// Resolve a long identifier to a nested field +val internal ResolveNestedField: + sink: TcResultsSink -> + ncenv: NameResolver -> + nenv: NameResolutionEnv -> + ad: AccessorDomain -> + recdTy: TType -> + lid: Ident list -> + Ident list * (Ident * AnonRecdTypeInfo option) list + /// Resolve a long identifier occurring in an expression position val internal ResolveExprLongIdent: sink: TcResultsSink -> diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index bc29a8c7310..b50f851e0a0 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1565,6 +1565,7 @@ featureTryWithInSeqExpressions,"Support for try-with in sequence expressions" featureWarningWhenCopyAndUpdateRecordChangesAllFields,"Raises warnings when an copy-and-update record expression changes all fields of a record." featureStaticMembersInInterfaces,"Static members in interfaces" featureNonInlineLiteralsAsPrintfFormat,"String values marked as literals and IL constants as printf format" +featureNestedCopyAndUpdate,"Nested record field copy-and-update" 3353,fsiInvalidDirective,"Invalid directive '#%s %s'" 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 2558f69a431..cc6f8b6dcaa 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -323,6 +323,8 @@ + + diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 4c8730e6163..fa0acceb0df 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -65,6 +65,7 @@ type LanguageFeature = | WarningWhenCopyAndUpdateRecordChangesAllFields | StaticMembersInInterfaces | NonInlineLiteralsAsPrintfFormat + | NestedCopyAndUpdate /// LanguageVersion management type LanguageVersion(versionText) = @@ -146,6 +147,7 @@ type LanguageVersion(versionText) = LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields, previewVersion LanguageFeature.StaticMembersInInterfaces, previewVersion LanguageFeature.NonInlineLiteralsAsPrintfFormat, previewVersion + LanguageFeature.NestedCopyAndUpdate, previewVersion ] @@ -264,6 +266,7 @@ type LanguageVersion(versionText) = | LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields -> FSComp.SR.featureWarningWhenCopyAndUpdateRecordChangesAllFields () | LanguageFeature.StaticMembersInInterfaces -> FSComp.SR.featureStaticMembersInInterfaces () | LanguageFeature.NonInlineLiteralsAsPrintfFormat -> FSComp.SR.featureNonInlineLiteralsAsPrintfFormat () + | LanguageFeature.NestedCopyAndUpdate -> FSComp.SR.featureNestedCopyAndUpdate () /// Get a version string associated with the given feature. static member GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index 650a1583cfb..c5c407e80b8 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -55,6 +55,7 @@ type LanguageFeature = | WarningWhenCopyAndUpdateRecordChangesAllFields | StaticMembersInInterfaces | NonInlineLiteralsAsPrintfFormat + | NestedCopyAndUpdate /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index d8f697bb4e0..b29d26f9944 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -647,24 +647,54 @@ type internal TypeCheckInfo let thereWereSomeQuals = not (Array.isEmpty quals) thereWereSomeQuals, quals - /// obtains captured typing for the given position - /// if type of captured typing is record - returns list of record fields - let GetRecdFieldsForExpr (r: range) = - let _, quals = GetExprTypingForPosition(r.End) - - let bestQual = - match quals with - | [||] -> None - | quals -> - quals - |> Array.tryFind (fun (_, _, _, rq) -> - ignore (r) // for breakpoint - posEq r.Start rq.Start) - - match bestQual with - | Some (ty, nenv, ad, m) when isRecdTy nenv.DisplayEnv.g ty -> - let items = ResolveRecordOrClassFieldsOfType ncenv m ad ty false - Some(items, nenv.DisplayEnv, m) + /// Returns the list of available record fields, taking into account potential nesting + let GetRecdFieldsForCopyAndUpdateExpr (identRange: range, plid: string list) = + let rec dive ty (denv: DisplayEnv) ad m plid isPastTypePrefix wasPathEmpty = + if isRecdTy denv.g ty then + let fields = + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) + |> List.filter (fun rfref -> not rfref.IsStatic && IsFieldInfoAccessible ad rfref) + + match plid with + | [] -> + if wasPathEmpty || isPastTypePrefix then + Some(fields |> List.map Item.RecdField, denv, m) + else + 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 + | _ -> + // Field name can be optionally qualified. + // If we haven't matched a field name yet, keep peeling off the prefix. + if isPastTypePrefix then + Some([], denv, m) + else + dive ty denv ad m rest false wasPathEmpty + else + match tryDestAnonRecdTy denv.g ty with + | ValueSome (anonInfo, tys) -> + match plid with + | [] -> + let items = + [ + for i in 0 .. anonInfo.SortedIds.Length - 1 do + Item.AnonRecdField(anonInfo, tys, i, anonInfo.SortedIds[i].idRange) + ] + + Some(items, denv, m) + | id :: rest -> + match anonInfo.SortedNames |> Array.tryFindIndex (fun x -> x = id) with + | Some i -> dive tys[i] denv ad m rest true wasPathEmpty + | _ -> Some([], denv, m) + | ValueNone -> Some([], denv, m) + + match + GetExprTypingForPosition identRange.End + |> snd + |> Array.tryFind (fun (_, _, _, rq) -> posEq identRange.Start rq.Start) + with + | Some (ty, nenv, ad, m) -> dive ty nenv.DisplayEnv ad m plid false plid.IsEmpty | _ -> None /// Looks at the exact expression types at the position to the left of the @@ -1251,8 +1281,8 @@ type internal TypeCheckInfo GetEnvironmentLookupResolutionsIncludingRecordFieldsAtPosition cursorPos [] envItems // Completion at ' { XXX = ... with ... } " - | Some (CompletionContext.RecordField (RecordContext.CopyOnUpdate (r, (plid, _)))) -> - match GetRecdFieldsForExpr(r) with + | Some (CompletionContext.RecordField (RecordContext.CopyOnUpdate (identRange, (plid, _)))) -> + match GetRecdFieldsForCopyAndUpdateExpr(identRange, plid) with | None -> Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, false)) |> Option.map toCompletionItems @@ -1260,8 +1290,9 @@ type internal TypeCheckInfo // Completion at ' { XXX = ... with ... } " | Some (CompletionContext.RecordField (RecordContext.Constructor (typeName))) -> - Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [ typeName ], false)) - |> Option.map toCompletionItems + GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [ typeName ], false) + |> toCompletionItems + |> Some // No completion at '...: string' | Some (CompletionContext.RecordField (RecordContext.Declaration true)) -> None diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index cd9c4a6d923..9c81e015460 100644 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -358,7 +358,7 @@ module SyntaxTraversal = | SynExpr.ArrayOrList (_, synExprList, _range) -> synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr - | SynExpr.AnonRecd (copyInfo = copyOpt; recordFields = synExprList) -> + | SynExpr.AnonRecd (copyInfo = copyOpt; recordFields = fields) -> [ match copyOpt with | Some (expr, (withRange, _)) -> @@ -373,7 +373,9 @@ module SyntaxTraversal = else None) | _ -> () - for _, _, x in synExprList do + + for field, _, x in fields do + yield dive () field.Range (fun () -> visitor.VisitRecordField(path, copyOpt |> Option.map fst, Some field)) yield dive x x.Range traverseSynExpr ] |> pick expr diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index 78d276948ff..e02559815a3 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -482,7 +482,7 @@ type SynExpr = | AnonRecd of isStruct: bool * copyInfo: (SynExpr * BlockSeparator) option * - recordFields: (Ident * range option * SynExpr) list * + recordFields: (SynLongIdent * range option * SynExpr) list * range: range * trivia: SynExprAnonRecdTrivia diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 222c0131088..c9619454ded 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -554,7 +554,7 @@ type SynExpr = | AnonRecd of isStruct: bool * copyInfo: (SynExpr * BlockSeparator) option * - recordFields: (Ident * range option * SynExpr) list * + recordFields: (SynLongIdent * range option * SynExpr) list * range: range * trivia: SynExprAnonRecdTrivia diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index a6ff990e09d..7e4f605098c 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -4946,8 +4946,9 @@ braceBarExprCore: { let orig, flds = $2 let flds = flds |> List.choose (function - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, Some e, _) -> Some (id, mEquals, e) - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, None, _) -> Some (id, mEquals, arbExpr("anonField", id.idRange)) + | SynExprRecordField((synLongIdent, _), mEquals, Some e, _) when orig.IsSome -> Some (synLongIdent, mEquals, e) // copy-and-update, long identifier signifies nesting + | SynExprRecordField((SynLongIdent([ _id ], _, _) as synLongIdent, _), mEquals, Some e, _) -> Some (synLongIdent, mEquals, e) // record construction, long identifier not valid + | SynExprRecordField((synLongIdent, _), mEquals, None, _) -> Some (synLongIdent, mEquals, arbExpr("anonField", synLongIdent.Range)) | _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None) let mLeftBrace = rhs parseState 1 let mRightBrace = rhs parseState 3 @@ -4959,10 +4960,9 @@ braceBarExprCore: { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBraceBar()) let orig, flds = $2 let flds = - flds |> List.choose (function - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, Some e, _) -> Some (id, mEquals, e) - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, None, _) -> Some (id, mEquals, arbExpr("anonField", id.idRange)) - | _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None) + flds |> List.map (function + | SynExprRecordField((synLongIdent, _), mEquals, Some e, _) -> (synLongIdent, mEquals, e) + | SynExprRecordField((synLongIdent, _), mEquals, None, _) -> (synLongIdent, mEquals, arbExpr("anonField", synLongIdent.Range))) let mLeftBrace = rhs parseState 1 let mExpr = rhs parseState 2 (fun (mStruct: range option) -> diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 68cdf25a067..9e3558a0b6f 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index b2604d49576..1d8e7d0d13b 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index dc67c3f2698..8edaa9fb483 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 9509d593925..ff567add7d7 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 10fa8b85bd3..8f84b1b2389 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index ddb538a61aa..3768e8775b7 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index dfd8d33f439..b74b6049078 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index db9e2aa159a..71a7667f882 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 5eea3173037..401b42feba8 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 635418eb677..cf12ae9183a 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index c1c732db798..aa94610d3b5 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 4566ee7d65b..1d10b3ba1d6 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 777d9c4cb98..556c6cd5f38 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/tests/FSharp.Compiler.ComponentTests/Diagnostics/Records.fs b/tests/FSharp.Compiler.ComponentTests/Diagnostics/Records.fs index e5640db0f03..b1f80781c48 100644 --- a/tests/FSharp.Compiler.ComponentTests/Diagnostics/Records.fs +++ b/tests/FSharp.Compiler.ComponentTests/Diagnostics/Records.fs @@ -65,4 +65,30 @@ let updateWarn r = { r with F1 = 1; F2 = "" } |> shouldFail |> withDiagnostics [ (Warning 3560, Line 6, Col 20, Line 6, Col 46, "This copy-and-update record expression changes all fields of record type 'Records.R'. Consider using the record construction syntax instead.") + ] + +[] +let ``Warning not emitted for generated record updates within a nested copy-and-update expression in a lang preview``() = + Fsx """ +type AnotherNestedRecTy = { A: int; B: int } + +type NestdRecTy = { C: {| c: AnotherNestedRecTy |} } + +type RecTy = { D: NestdRecTy; I: int } + +// vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv +let t1 (x: NestdRecTy) = { x with C.c = Unchecked.defaultof<_> } + +// Do not report for the nested NestdRecTy update +let t2 (x: RecTy) (a: AnotherNestedRecTy) = { x with D.C.c = { a with A = 3 } } + +// vvvvvvvvvvvvvvvvvvvvvvv +let t3 (x: RecTy) (a: AnotherNestedRecTy) = { x with D.C.c = { a with A = 3; B = 4 } } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Warning 3560, Line 9, Col 26, Line 9, Col 65, "This copy-and-update record expression changes all fields of record type 'Test.NestdRecTy'. Consider using the record construction syntax instead.") + (Warning 3560, Line 15, Col 62, Line 15, Col 85, "This copy-and-update record expression changes all fields of record type 'Test.AnotherNestedRecTy'. Consider using the record construction syntax instead.") ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 70c8ac2146d..8feb7273618 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -186,7 +186,8 @@ - + + diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs new file mode 100644 index 00000000000..ce1eb6b6703 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -0,0 +1,392 @@ +module FSharp.Compiler.ComponentTests.Language.CopyAndUpdateTests + +open Xunit +open FSharp.Test.Compiler +open StructuredResultsAsserts + +[] +let ``Cannot update the same field twice in nested copy-and-update``() = + FSharp """ +type NestdRecTy = { B: string } + +type RecTy = { D: NestdRecTy; E: string option } + +let t2 x = { x with D.B = "a"; D.B = "b" } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 668, Line 6, Col 21, Line 6, Col 22, "The field 'B' appears twice in this record expression or pattern") + ] + +[] +let ``Cannot use nested copy-and-update in lang version70``() = + FSharp """ +type NestdRecTy = { B: string } + +type RecTy = { D: NestdRecTy; E: string option } + +let t2 x = { x with D.B = "a" } + """ + |> withLangVersion70 + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 3350, Line 6, Col 21, Line 6, Col 24, "Feature 'Nested record field copy-and-update' is not available in F# 7.0. Please use language version 'PREVIEW' or greater.") + ] + +[] +let ``Nested copy-and-update merges same level updates``() = + FSharp """ +module CopyAndUpdateTests + +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: AnotherNestedRecTy; C: string } + +type RecTy = { D: NestdRecTy; E: string option } + +let t2 x = { x with D.B.A = 1; D.C = "ads" } + """ + |> withLangVersionPreview + |> withNoDebug + |> withOptimize + |> compile + |> shouldSucceed + |> verifyIL [ +(* + public static CopyAndUpdateTests.RecTy t2(CopyAndUpdateTests.RecTy x) + { + return new CopyAndUpdateTests.RecTy(new CopyAndUpdateTests.NestdRecTy(new CopyAndUpdateTests.AnotherNestedRecTy(1), "ads"), x.E@); + } +*) + """ +.method public static class CopyAndUpdateTests/RecTy + t2(class CopyAndUpdateTests/RecTy x) cil managed +{ + + .maxstack 8 + IL_0000: ldc.i4.1 + IL_0001: newobj instance void CopyAndUpdateTests/AnotherNestedRecTy::.ctor(int32) + IL_0006: ldstr "ads" + IL_000b: newobj instance void CopyAndUpdateTests/NestdRecTy::.ctor(class CopyAndUpdateTests/AnotherNestedRecTy, + string) + IL_0010: ldarg.0 + IL_0011: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1 CopyAndUpdateTests/RecTy::E@ + IL_0016: newobj instance void CopyAndUpdateTests/RecTy::.ctor(class CopyAndUpdateTests/NestdRecTy, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1) + IL_001b: ret +} + """ + ] + +[] +let ``Nested copy-and-update correctly updates fields in nominal record``() = + FSharp """ +module CopyAndUpdateTests + +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: string; C: AnotherNestedRecTy } + +type RecTy = { D: NestdRecTy; E: string option; F: int } + +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = None; F = 42 } + +let actual1 = { t1 with D.B = "t2" } +let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None; F = 42 } + +let actual2 = { t1 with D.C.A = 3; E = Some "a" } +let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a"; F = 42 } + +if actual1 <> expected1 then + failwith "actual1 does not equal expected1" + +if actual2 <> expected2 then + failwith "actual2 does not equal expected2" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Nested copy-and-update correctly updates fields in nominal record with dotted field``() = + FSharp """ +module CopyAndUpdateTests + +type A = { B: string } + +type Foo = { ``A.B``: string; A: A; C: int } + +let t1 = { ``A.B`` = "fooAB"; A = { B = "fooB" }; C = 42 } + +let actual = { t1 with Foo.``A.B`` = "barAB"; Foo.A.B = "barB" } +let expected = { ``A.B`` = "barAB"; A = { B = "barB" }; C = 42 } + +if actual <> expected then + failwith "actual does not equal expected" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Nested copy-and-update correctly updates fields in nominal generic record``() = + FSharp """ +module CopyAndUpdateTests + +type AnotherNestedRecTy = { A: int } + +type NestdRecTy<'b> = { B: 'b; C: AnotherNestedRecTy } + +type RecTy<'b, 'e> = { D: NestdRecTy<'b>; E: 'e option; F: int } + +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = Option.None; F = 42 } + +let actual1 = { t1 with D.B = "t2" } +let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None; F = 42 } + +let actual2 = { t1 with D.C.A = 3; E = Some "a" } +let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a"; F = 42 } + +if actual1 <> expected1 then + failwith "actual1 does not equal expected1" + +if actual2 <> expected2 then + failwith "actual2 does not equal expected2" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Nested copy-and-update correctly updates fields in nominal struct record``() = + FSharp """ +module CopyAndUpdateTests + +[] +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: string; C: AnotherNestedRecTy } + +[] +type RecTy = { D: NestdRecTy; E: string option; F: int } + +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = None; F = 42 } + +let actual1 = { t1 with D.B = "t2" } +let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None; F = 42 } + +let actual2 = { t1 with D.C.A = 3; E = Some "a" } +let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a"; F = 42 } + +if actual1 <> expected1 then + failwith "actual1 does not equal expected1" + +if actual2 <> expected2 then + failwith "actual2 does not equal expected2" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Nested copy-and-update correctly updates fields in anonymous record``() = + FSharp """ +module CopyAndUpdateTests + +let t1 = {| D = {| B = "t1"; C = struct {| A = 1 |} |}; E = Option.None |} + +let actual1 = {| t1 with D.B = "t2" |} +let expected1 = {| D = {| B = "t2"; C = struct {| A = 1 |} |}; E = None |} + +let actual2 = {| t1 with D.C.A = 3; E = Some "a" |} +let expected2 = {| D = {| B = "t1"; C = struct {| A = 3 |} |}; E = Some "a" |} + +if actual1 <> expected1 then + failwith "actual1 does not equal expected1" + +if actual2 <> expected2 then + failwith "actual2 does not equal expected2" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Qualified record field names are correctly recognized in nested copy-and-update``() = + FSharp """ +module CopyAndUpdateTests + +module U = + module U = + type G = { U: {| a: G |}; I: int } + +let moduleModulePrefix x = { x with U.U.U.a.U.a.U.a.I = 1 } + +let moduleModuleTypePrefix x = { x with U.U.G.U.a.I = 1 } + +open U + +let modulePrefix x = { x with U.U.a.I = 1 } + +let moduleTypePrefix x = { x with U.G.U.a.I = 1 } + +open U + +let typePrefix x = { x with G.U.a.I = 1 } + +let modulePrefix2 x = { x with U.U.a.I = 1 } + +let moduleTypePrefix2 x = { x with U.G.U.a.I = 1 } + +let noPrefix x = { x with U.a.I = 1 } + +let c3 = { U.G.U = Unchecked.defaultof<_>; I = 3 } + +let c4 = { U.U = Unchecked.defaultof<_>; I = 3 } + """ + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + +[] +let ``Nested copy-and-update works correctly on recursive records``() = + FSharp """ +module CopyAndUpdateTests + +type G<'t> = { T: 't; U: {| a: G<'t> |}; I: int } + +let f x = { x with U.a.U.a.I = 0; I = -1 } + +let start = { T = "a"; I = 1; U = {| a = { T = "a"; I = 2; U = {| a = { T = "a"; I = 3; U = Unchecked.defaultof<_> } |} } |} } + +let actual = f start +let expected = { T = "a"; I = -1; U = {| a = { T = "a"; I = 2; U = {| a = { T = "a"; I = 0; U = Unchecked.defaultof<_> } |} } |} } + +if actual <> expected then + failwith "actual does not equal expected" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Nested copy-and-update does not compile when assigning values of the wrong type``() = + FSharp """ +module CopyAndUpdateTests + +type AnotherNestedRecTy = { A: int } + +type NestdRecTy<'b> = { B: 'b; C: AnotherNestedRecTy } + +type RecTy<'b, 'e> = { D: NestdRecTy<'b>; E: 'e option; F: int } + +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = Option.None; F = 42 } + +let actual1 = { t1 with D.B = 1 } + +let actual2 = { t1 with D.C.A = 3; E = Some 1.0 } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withResults [ + { + Error = Error 1 + Range = { StartLine = 12 + StartColumn = 31 + EndLine = 12 + EndColumn = 32 } + Message = @"This expression was expected to have type + 'string' +but here has type + 'int' " + } + { + Error = Error 1 + Range = { StartLine = 14 + StartColumn = 45 + EndLine = 14 + EndColumn = 48 } + Message = @"This expression was expected to have type + 'string' +but here has type + 'float' " + } + ] + +[] +let ``Anonymous record with nested copy-and-update can change shape``() = + FSharp """ +module CopyAndUpdateTests + +type RecTy = { D: int; E: string option } + +let start = {| R = { D = 2; E = Some "e" }; S = 3 |} + +let actual = {| start with R.E = None; S = "May I be a string now?"; T = 4 |} + +let expected = {| R = { D = 2; E = None }; S = "May I be a string now?"; T = 4 |} + +if actual <> expected then + failwith "actual does not equal expected" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Anonymous record in a nominal record with nested copy-and-update cannot change shape``() = + FSharp """ +module CopyAndUpdateTests + +type RecTy = { D: int; E: {| A: int |} } + +let f x = { x with E.A = "May I be a string now?" } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withResult { + Error = Error 1 + Range = { StartLine = 6 + StartColumn = 26 + EndLine = 6 + EndColumn = 50 } + Message = "This expression was expected to have type + 'int' +but here has type + 'string' " + } + +[] +let ``Nested copy-and-update does not compile when referencing invalid fields``() = + FSharp """ +module CopyAndUpdateTests + +type NestdRecTy = { B: string; G: {| a: int |} } + +type RecTy = { D: NestdRecTy; E: string option } + +let t1 x = { x with D.B.A = "a" } +let t2 x = { x with D.C = "a" } +let t3 x = { x with D.G.b = "a" } +let t4 x = { x with C.D = "a" } +let t5 (x: {| a: int; b: NestdRecTy |}) = {| x with b.C = "a" |} +let t6 (x: {| a: int; b: NestdRecTy |}) = {| x with b.G.b = "a" |} +let t7 (x: {| a: int; b: NestdRecTy |}) = {| x with c.D = "a" |} + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 39, Line 8, Col 25, Line 8, Col 26, "The record label 'A' is not defined.") + (Error 1129, Line 9, Col 23, Line 9, Col 24, "The record type 'NestdRecTy' does not contain a label 'C'.") + (Error 1129, Line 10, Col 25, Line 10, Col 26, "The record type '{| a: int |}' does not contain a label 'b'.") + (Error 39, Line 11, Col 21, Line 11, Col 22, "The namespace or module 'C' is not defined.") + (Error 1129, Line 12, Col 55, Line 12, Col 56, "The record type 'NestdRecTy' does not contain a label 'C'.") + (Error 1129, Line 13, Col 57, Line 13, Col 58, "The record type '{| a: int |}' does not contain a label 'b'.") + (Error 1129, Line 14, Col 53, Line 14, Col 54, "The record type '{| a: int; b: NestdRecTy |}' does not contain a label 'c'.") + ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index 9bdc7c4b47b..92cb8e737b5 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -6172,8 +6172,8 @@ FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAno FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia trivia FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] copyInfo FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] get_copyInfo() FSharp.Compiler.Syntax.SynExpr+App: Boolean get_isInfix() @@ -6911,7 +6911,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsWhile() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturn() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturnFrom() FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAddressOf(Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewApp(FSharp.Compiler.Syntax.ExprAtomicFlag, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArbitraryAfterError(System.String, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArrayOrList(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], FSharp.Compiler.Text.Range) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index 9bdc7c4b47b..92cb8e737b5 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -6172,8 +6172,8 @@ FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAno FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia trivia FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] copyInfo FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] get_copyInfo() FSharp.Compiler.Syntax.SynExpr+App: Boolean get_isInfix() @@ -6911,7 +6911,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsWhile() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturn() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturnFrom() FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAddressOf(Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewApp(FSharp.Compiler.Syntax.ExprAtomicFlag, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArbitraryAfterError(System.String, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArrayOrList(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], FSharp.Compiler.Text.Range) diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl index 6afab716003..40b916124b1 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl @@ -7,13 +7,15 @@ ImplFile [Expr (AnonRecd (false, None, - [(X, Some (1,5--1,6), Const (Int32 1, (1,7--1,8)))], - (1,0--1,11), { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11)); + [(SynLongIdent ([X], [], [None]), Some (1,5--1,6), + Const (Int32 1, (1,7--1,8)))], (1,0--1,11), + { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11)); Expr (AnonRecd (true, None, - [(Y, Some (2,12--2,13), Const (Int32 2, (2,14--2,15)))], - (2,0--2,18), { OpeningBraceRange = (2,7--2,9) }), (2,0--2,18)); + [(SynLongIdent ([Y], [], [None]), Some (2,12--2,13), + Const (Int32 2, (2,14--2,15)))], (2,0--2,18), + { OpeningBraceRange = (2,7--2,9) }), (2,0--2,18)); Expr (AnonRecd (false, None, [], (3,0--3,5), { OpeningBraceRange = (3,0--3,2) }), diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl index 762a3ce6168..4b708f29415 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl @@ -7,7 +7,8 @@ ImplFile [Expr (AnonRecd (false, None, - [(X, Some (1,5--1,6), Const (Int32 0, (1,7--1,8)))], (1,0--2,0), + [(SynLongIdent ([X], [], [None]), Some (1,5--1,6), + Const (Int32 0, (1,7--1,8)))], (1,0--2,0), { OpeningBraceRange = (1,0--1,2) }), (1,0--2,0))], PreXmlDocEmpty, [], None, (1,0--2,0), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl index 321d08b8859..63f45685825 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl @@ -7,8 +7,9 @@ ImplFile [Expr (AnonRecd (true, None, - [(X, Some (1,12--1,13), Const (Int32 0, (1,14--1,15)))], - (1,0--2,0), { OpeningBraceRange = (1,7--1,9) }), (1,0--2,0))], + [(SynLongIdent ([X], [], [None]), Some (1,12--1,13), + Const (Int32 0, (1,14--1,15)))], (1,0--2,0), + { OpeningBraceRange = (1,7--1,9) }), (1,0--2,0))], PreXmlDocEmpty, [], None, (1,0--2,0), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] CodeComments = [] }, set [])) diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs new file mode 100644 index 00000000000..60a1f3f2178 --- /dev/null +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs @@ -0,0 +1 @@ +let f x = {| x with R.D = "s"; A = 3 |} diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs.bsl new file mode 100644 index 00000000000..b0b647bcf92 --- /dev/null +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs.bsl @@ -0,0 +1,34 @@ +ImplFile + (ParsedImplFileInput + ("/root/Expression/AnonymousRecords-06.fs", false, + QualifiedNameOfFile AnonymousRecords-06, [], [], + [SynModuleOrNamespace + ([AnonymousRecords-06], false, AnonModule, + [Let + (false, + [SynBinding + (None, Normal, false, false, [], + PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), + SynValData + (None, + SynValInfo + ([[SynArgInfo ([], false, Some x)]], + SynArgInfo ([], false, None)), None), + LongIdent + (SynLongIdent ([f], [], [None]), None, None, + Pats [Named (SynIdent (x, None), false, None, (1,6--1,7))], + None, (1,4--1,7)), None, + AnonRecd + (false, Some (Ident x, ((1,15--1,19), None)), + [(SynLongIdent ([R; D], [(1,21--1,22)], [None; None]), + Some (1,24--1,25), + Const (String ("s", Regular, (1,26--1,29)), (1,26--1,29))); + (SynLongIdent ([A], [], [None]), Some (1,33--1,34), + Const (Int32 3, (1,35--1,36)))], (1,10--1,39), + { OpeningBraceRange = (1,10--1,12) }), (1,4--1,7), + NoneAtLet, { LeadingKeyword = Let (1,0--1,3) + InlineKeyword = None + EqualsRange = Some (1,8--1,9) })], (1,0--1,39))], + PreXmlDocEmpty, [], None, (1,0--2,0), { LeadingKeyword = None })], + (true, false), { ConditionalDirectives = [] + CodeComments = [] }, set [])) diff --git a/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl b/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl index f8825418def..a1fcc21b59c 100644 --- a/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl @@ -7,8 +7,9 @@ ImplFile [Expr (AnonRecd (false, None, - [(A, Some (1,5--1,6), Const (Int32 1, (1,7--1,8)))], - (1,0--1,11), { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11))], + [(SynLongIdent ([A], [], [None]), Some (1,5--1,6), + Const (Int32 1, (1,7--1,8)))], (1,0--1,11), + { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11))], PreXmlDocEmpty, [], None, (1,0--1,11), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] CodeComments = [] }, set [])) diff --git a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl index 44387eb400f..40047163be4 100644 --- a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl @@ -6,8 +6,10 @@ ImplFile ([SynExprAnonRecdWithStructKeyword], false, AnonModule, [Expr (AnonRecd - (true, None, [(Foo, Some (3,11--3,12), Ident someValue)], - (2,0--5,16), { OpeningBraceRange = (3,4--3,6) }), (2,0--5,16)); + (true, None, + [(SynLongIdent ([Foo], [], [None]), Some (3,11--3,12), + Ident someValue)], (2,0--5,16), + { OpeningBraceRange = (3,4--3,6) }), (2,0--5,16)); Expr (AnonRecd (true, None, [], (7,0--7,12), { OpeningBraceRange = (7,7--7,9) }), diff --git a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl index d9e0728c813..e9a90eeccde 100644 --- a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl @@ -10,10 +10,13 @@ ImplFile [Expr (AnonRecd (false, None, - [(X, Some (2,5--2,6), Const (Int32 5, (2,7--2,8))); - (Y, Some (3,8--3,9), Const (Int32 6, (3,10--3,11))); - (Z, Some (4,12--4,13), Const (Int32 7, (4,14--4,15)))], - (2,0--4,18), { OpeningBraceRange = (2,0--2,2) }), (2,0--4,18))], + [(SynLongIdent ([X], [], [None]), Some (2,5--2,6), + Const (Int32 5, (2,7--2,8))); + (SynLongIdent ([Y], [], [None]), Some (3,8--3,9), + Const (Int32 6, (3,10--3,11))); + (SynLongIdent ([Z], [], [None]), Some (4,12--4,13), + Const (Int32 7, (4,14--4,15)))], (2,0--4,18), + { OpeningBraceRange = (2,0--2,2) }), (2,0--4,18))], PreXmlDocEmpty, [], None, (2,0--4,18), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] CodeComments = [] }, set [])) diff --git a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs index 81c34d547a1..de8d75bd642 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs @@ -1339,3 +1339,105 @@ type A = // Attribute on enum case - All settable properties available VerifyCompletionList(fileContents, "| [] + let ``Completion list for nested copy and update contains correct record fields, nominal`` () = + let fileContents = + """ +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: string; C: AnotherNestedRecTy } + +module F = + type RecTy = { D: NestdRecTy; E: string option } + +open F + +let t1 = { D = { B = "t1"; C = { A = 1; } }; E = None; } + +let t2 = { t1 with D.B = "12" } + +let t3 = { t2 with F.RecTy.d } + +let t4 = { t2 with F.RecTy.D. } + +let t5 = { t2 with F.RecTy.D.C. } + +let t6 = { t2 with E. } + +let t7 = { t2 with D.B. } + +let t8 = { t2 with F. } + +let t9 = { t2 with d } + +let t10 x = { x with d } + +let t11 = { t2 with NestdRecTy.C. } + +let t12 x = { x with F.RecTy.d } + +let t13 x = { x with RecTy.D. } +""" + + VerifyCompletionListExactly(fileContents, "t1 with ", [ "D"; "E" ]) + VerifyCompletionListExactly(fileContents, "t1 with D.", [ "B"; "C" ]) + + VerifyCompletionListExactly(fileContents, "let t3 = { t2 with F.RecTy.d", [ "D"; "E" ]) + + VerifyCompletionListExactly(fileContents, "let t4 = { t2 with F.RecTy.D.", [ "B"; "C" ]) + + VerifyCompletionListExactly(fileContents, "let t5 = { t2 with F.RecTy.D.C.", [ "A" ]) + + VerifyNoCompletionList(fileContents, "let t6 = { t2 with E.") + + VerifyNoCompletionList(fileContents, "let t7 = { t2 with D.B.") + + VerifyCompletionListExactly(fileContents, "let t8 = { t2 with F.", [ "D"; "E"; "RecTy" ]) + + VerifyCompletionListExactly(fileContents, "let t9 = { t2 with d", [ "D"; "E" ]) + + // The type of `x` is not known, so show fields of records in scope + VerifyCompletionList(fileContents, "let t10 x = { x with d", [ "A"; "B"; "C"; "D"; "E" ], []) + + VerifyNoCompletionList(fileContents, "let t11 = { t2 with NestdRecTy.C.") + + VerifyCompletionListExactly(fileContents, "let t12 x = { x with F.RecTy.d", [ "D"; "E" ]) + + VerifyCompletionListExactly(fileContents, "let t13 x = { x with RecTy.D.", [ "B"; "C" ]) + + [] + let ``Completion list for nested copy and update contains correct record fields, mixed nominal and anonymous`` () = + let fileContents = + """ +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: string; C: {| C: AnotherNestedRecTy |} } + +type RecTy = { D: NestdRecTy; E: {| a: string |} } + +let t1 x = { x with D.C.C.A = 12; E.a = "a" } + +let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = "a"; D.B = "z" |} +""" + + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.", [ "B"; "C" ]) + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.", [ "C" ]) + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.C.", [ "A" ]) + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.C.A = 12; ", [ "D"; "E" ]) + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.C.A = 12; E.", [ "a" ]) + + VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with ", [ "D"; "E" ]) + VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.", [ "a" ]) + + VerifyCompletionListExactly( + fileContents, + "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; ", + [ "D"; "E" ] + ) + + VerifyCompletionListExactly( + fileContents, + "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; D.", + [ "B"; "C" ] + )