Skip to content

Commit b43fc1d

Browse files
brianrourkebollbrianrourkeboll
committed
Fix nested copy+updates; update tests
1 parent fcb17ad commit b43fc1d

File tree

11 files changed

+65
-60
lines changed

11 files changed

+65
-60
lines changed

‎src/Compiler/Checking/CheckPatterns.fs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -457,13 +457,22 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m =
457457
phase2, acc
458458

459459
and TcRecordPat warnOnUpper (cenv: cenv) env vFlags patEnv ty fieldPats m =
460+
let idents =
461+
fieldPats
462+
|> List.map (fun fieldPat ->
463+
let (|FrontAndBack|) = List.frontAndBack
464+
match fieldPat with
465+
| NamePatPairField (fieldName = SynLongIdent (id = [fieldId]))
466+
| NamePatPairField (fieldName = SynLongIdent (id = FrontAndBack (_, fieldId))) -> fieldId)
467+
460468
let fieldPats =
461469
fieldPats
462470
|> List.map (fun (NamePatPairField(fieldName = fieldLid; pat = pat)) ->
463471
match fieldLid.LongIdent with
464472
| [id] -> ExplicitOrSpread.Explicit (([], id), pat)
465473
| lid -> ExplicitOrSpread.Explicit (List.frontAndBack lid, pat))
466474

475+
CheckRecdExprDuplicateFields idents
467476
match BuildFieldMap cenv env false ty fieldPats m with
468477
| None -> (fun _ -> TPat_error m), patEnv
469478
| Some(tinst, tcref, fldsmap, _fldsList) ->

‎src/Compiler/Checking/CheckRecordSyntaxHelpers.fs‎

Lines changed: 3 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -151,25 +151,16 @@ let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid
151151

152152
match access, fields with
153153
| _, [] -> failwith "unreachable"
154-
| accessIds, [ (fieldId, _) ] ->
155-
match exprBeingAssigned with
156-
| ExplicitOrSpread.Explicit exprBeingAssigned -> ExplicitOrSpread.Explicit((accessIds, fieldId), Some exprBeingAssigned)
157-
| ExplicitOrSpread.Spread exprBeingAssigned -> ExplicitOrSpread.Spread((accessIds, fieldId), Some exprBeingAssigned)
158-
154+
| accessIds, [ (fieldId, _) ] -> (accessIds, fieldId), Some exprBeingAssigned
159155
| accessIds, (outerFieldId, item) :: rest ->
160156
checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid)
161157

162158
CallNameResolutionSink cenv.tcSink (outerFieldId.idRange, env.NameEnv, item, [], ItemOccurrence.Use, env.AccessRights)
163159

164160
let outerFieldId = ident (outerFieldId.idText, outerFieldId.idRange.MakeSynthetic())
165161

166-
match exprBeingAssigned with
167-
| ExplicitOrSpread.Explicit synExpr ->
168-
ExplicitOrSpread.Explicit(
169-
(accessIds, outerFieldId),
170-
Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) outerFieldId rest synExpr)
171-
)
172-
| ExplicitOrSpread.Spread exprBeingAssigned -> ExplicitOrSpread.Spread((accessIds, outerFieldId), Some exprBeingAssigned)
162+
(accessIds, outerFieldId),
163+
Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) outerFieldId rest exprBeingAssigned)
173164

174165
/// When the original expression in copy-and-update is more complex than `{ x with ... }`, like `{ f () with ... }`,
175166
/// we bind it first, so that it's not evaluated multiple times during a nested update

‎src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,9 +17,9 @@ val TransformAstForNestedUpdates:
1717
env: TcEnv ->
1818
overallTy: TType ->
1919
lid: LongIdent ->
20-
exprBeingAssigned: ExplicitOrSpread<SynExpr, 'Spread> ->
20+
exprBeingAssigned: SynExpr ->
2121
withExpr: SynExpr * BlockSeparator ->
22-
ExplicitOrSpread<(Ident list * Ident) * SynExpr option, (Ident list * Ident) * 'Spread option>
22+
(Ident list * Ident) * SynExpr option
2323

2424
val BindOriginalRecdExpr:
2525
withExpr: SynExpr * BlockSeparator -> mkRecdExpr: ((SynExpr * BlockSeparator) option -> SynExpr) -> SynExpr

‎src/Compiler/Checking/Expressions/CheckExpressions.fs‎

Lines changed: 17 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1918,11 +1918,6 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ExplicitOrSpread<(Ident l
19181918
let ad = env.eAccessRights
19191919

19201920
let allFields = flds |> List.map (fun (ExplicitOrSpread.Explicit ((_, ident), _) | ExplicitOrSpread.Spread ((_, ident), _)) -> ident)
1921-
if allFields.Length > 1 then
1922-
// In the case of nested record fields on the same level in record copy-and-update.
1923-
// We need to reverse the list to get the correct order of fields.
1924-
let idents = if isPartial then allFields |> List.rev else allFields
1925-
CheckRecdExprDuplicateFields idents
19261921

19271922
let fldResolutions =
19281923
flds
@@ -7804,11 +7799,15 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m
78047799
// we assume that parse errors were already reported
78057800
raise (ReportedError None)
78067801

7807-
let ExplicitOrSpread.Explicit ((_, fieldId), _) | ExplicitOrSpread.Spread ((_, fieldId), _) as field =
7802+
let isFromNestedUpdate, fieldId, field =
78087803
match withExprOpt, synLongId.LongIdent, exprBeingAssigned with
7809-
| _, [ id ], _ -> ExplicitOrSpread.Explicit (([], id), exprBeingAssigned)
7810-
| Some (origExpr, blockSep), lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid (ExplicitOrSpread.Explicit exprBeingAssigned) (origExpr, blockSep)
7811-
| _ -> ExplicitOrSpread.Explicit (List.frontAndBack synLongId.LongIdent, exprBeingAssigned)
7804+
| _, [ id ], _ -> false, id, ExplicitOrSpread.Explicit (([], id), exprBeingAssigned)
7805+
| Some (origExpr, blockSep), lid, Some exprBeingAssigned ->
7806+
let _, id as longIdent, exprBeingAssigned = TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned (origExpr, blockSep)
7807+
true, id, ExplicitOrSpread.Explicit (longIdent, exprBeingAssigned)
7808+
| _ ->
7809+
let _, id as longIdent = List.frontAndBack synLongId.LongIdent
7810+
false, id, ExplicitOrSpread.Explicit (longIdent, exprBeingAssigned)
78127811

78137812
let flds =
78147813
flds |> Map.change fieldId.idText (function
@@ -7827,7 +7826,8 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m
78277826
//
78287827
// Keep both, but error.
78297828
| Some (LeftwardExplicit, dupes) ->
7830-
errorR (Duplicate ("field", fieldId.idText, m))
7829+
if not isFromNestedUpdate then
7830+
errorR (Error (FSComp.SR.tcMultipleFieldsInRecord fieldId.idText, m))
78317831
Some (LeftwardExplicit, (i, field) :: dupes)
78327832

78337833
// Rightward explicit field shadowing leftward spread field.
@@ -8359,11 +8359,13 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or
83598359
List.rev spreadSrcs, fieldsInOriginalOrder, tpenv
83608360

83618361
| SynExprAnonRecordFieldOrSpread.Field (SynExprAnonRecordField (fieldName = synLongIdent; expr = exprBeingAssigned; range = m), _) :: fieldsAndSpreads ->
8362-
let ExplicitOrSpread.Explicit ((_, fieldId), _) | ExplicitOrSpread.Spread ((_, fieldId), _) as field =
8362+
let isFromNestedUpdate, fieldId, field =
83638363
match synLongIdent.LongIdent with
83648364
| [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), mWholeExpr))
8365-
| [ id ] -> ExplicitOrSpread.Explicit (([], id), Some exprBeingAssigned)
8366-
| lid -> TransformAstForNestedUpdates cenv env origExprTy lid (ExplicitOrSpread.Explicit exprBeingAssigned) (origExpr, blockSeparator)
8365+
| [ id ] -> false, id, ExplicitOrSpread.Explicit (([], id), Some exprBeingAssigned)
8366+
| lid ->
8367+
let _, id as longIdent, exprBeingAssigned = TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)
8368+
true, id, ExplicitOrSpread.Explicit (longIdent, exprBeingAssigned)
83678369

83688370
let flds =
83698371
flds |> Map.change fieldId.idText (function
@@ -8382,7 +8384,8 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or
83828384
//
83838385
// Keep both, but error.
83848386
| Some (LeftwardExplicit, dupes) ->
8385-
errorR (Error (FSComp.SR.tcAnonRecdDuplicateFieldId fieldId.idText, m))
8387+
if not isFromNestedUpdate then
8388+
errorR (Error (FSComp.SR.tcAnonRecdDuplicateFieldId fieldId.idText, m))
83868389
Some (LeftwardExplicit, (i, field) :: dupes)
83878390

83888391
// Rightward explicit field shadowing leftward spread field.

‎src/Compiler/Checking/Expressions/CheckExpressions.fsi‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -895,6 +895,9 @@ val UnifyTupleTypeAndInferCharacteristics:
895895
'T list ->
896896
TupInfo * TTypes
897897

898+
/// Helper used to check for duplicate fields in records.
899+
val CheckRecdExprDuplicateFields: elems: Ident list -> unit
900+
898901
/// Helper used to check both record expressions and record patterns
899902
val BuildFieldMap:
900903
cenv: TcFileState ->

‎tests/FSharp.Compiler.ComponentTests/Conformance/Constraints/Unmanaged.fs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
22

33
namespace Conformance.Constraints
44

@@ -95,7 +95,7 @@ test (ValueSome (struct {|Field = Some 42|}))
9595
|> withDiagnostics [
9696
Error 1, Line 3, Col 17, Line 3, Col 22, "A generic construct requires that the type 'string' is an unmanaged type"
9797
Error 1, Line 4, Col 28, Line 4, Col 33, "A generic construct requires that the type 'string' is an unmanaged type"
98-
Error 1, Line 5, Col 35, Line 5, Col 42, "A generic construct requires that the type ''a option' is an unmanaged type" ]
98+
Error 1, Line 5, Col 35, Line 5, Col 42, "A generic construct requires that the type 'int option' is an unmanaged type" ]
9999

100100
[<Fact>]
101101
let ``Option not considered unmanaged`` () =

‎tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -446,7 +446,7 @@ let v = {| A = 1; A = 2 |}
446446
|> compile
447447
|> shouldFail
448448
|> withDiagnostics [
449-
(Error 3522, Line 2, Col 12, Line 2, Col 13, "The field 'A' appears multiple times in this record expression.")
449+
(Error 3522, Line 2, Col 19, Line 2, Col 24, "The field 'A' appears multiple times in this record expression.")
450450
]
451451

452452
[<Fact>]
@@ -457,8 +457,8 @@ let v = {| A = 1; A = 2; A = 3 |}
457457
|> compile
458458
|> shouldFail
459459
|> withDiagnostics [
460-
(Error 3522, Line 2, Col 12, Line 2, Col 13, "The field 'A' appears multiple times in this record expression.")
461-
(Error 3522, Line 2, Col 19, Line 2, Col 20, "The field 'A' appears multiple times in this record expression.")
460+
Error 3522, Line 2, Col 19, Line 2, Col 24, "The field 'A' appears multiple times in this record expression."
461+
Error 3522, Line 2, Col 26, Line 2, Col 31, "The field 'A' appears multiple times in this record expression."
462462
]
463463

464464
[<Fact>]
@@ -469,8 +469,8 @@ let v = {| A = 0; B = 2; A = 5; B = 6 |}
469469
|> compile
470470
|> shouldFail
471471
|> withDiagnostics [
472-
(Error 3522, Line 2, Col 12, Line 2, Col 13, "The field 'A' appears multiple times in this record expression.")
473-
(Error 3522, Line 2, Col 19, Line 2, Col 20, "The field 'B' appears multiple times in this record expression.")
472+
Error 3522, Line 2, Col 26, Line 2, Col 31, "The field 'A' appears multiple times in this record expression."
473+
Error 3522, Line 2, Col 33, Line 2, Col 38, "The field 'B' appears multiple times in this record expression."
474474
]
475475

476476
[<Fact>]
@@ -481,7 +481,7 @@ let v = {| A = 2; C = "W"; A = 8; B = 6 |}
481481
|> compile
482482
|> shouldFail
483483
|> withDiagnostics [
484-
(Error 3522, Line 2, Col 12, Line 2, Col 13, "The field 'A' appears multiple times in this record expression.")
484+
Error 3522, Line 2, Col 28, Line 2, Col 33, "The field 'A' appears multiple times in this record expression."
485485
]
486486

487487
[<Fact>]
@@ -492,8 +492,8 @@ let v = {| A = 0; C = ""; A = 1; B = 2; A = 5 |}
492492
|> compile
493493
|> shouldFail
494494
|> withDiagnostics [
495-
(Error 3522, Line 2, Col 12, Line 2, Col 13, "The field 'A' appears multiple times in this record expression.")
496-
(Error 3522, Line 2, Col 27, Line 2, Col 28, "The field 'A' appears multiple times in this record expression.")
495+
Error 3522, Line 2, Col 27, Line 2, Col 32, "The field 'A' appears multiple times in this record expression."
496+
Error 3522, Line 2, Col 41, Line 2, Col 46, "The field 'A' appears multiple times in this record expression."
497497
]
498498

499499
[<Fact>]
@@ -504,8 +504,8 @@ let v = {| ``A`` = 0; B = 5; A = ""; B = 0 |}
504504
|> compile
505505
|> shouldFail
506506
|> withDiagnostics [
507-
(Error 3522, Line 2, Col 12, Line 2, Col 17, "The field 'A' appears multiple times in this record expression.")
508-
(Error 3522, Line 2, Col 23, Line 2, Col 24, "The field 'B' appears multiple times in this record expression.")
507+
Error 3522, Line 2, Col 30, Line 2, Col 36, "The field 'A' appears multiple times in this record expression."
508+
Error 3522, Line 2, Col 38, Line 2, Col 43, "The field 'B' appears multiple times in this record expression."
509509
]
510510

511511
[<Fact>]

‎tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/RecordTypes.fs‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -441,7 +441,7 @@ module RecordTypes =
441441
|> typecheck
442442
|> shouldFail
443443
|> withDiagnostics [
444-
(Error 668, Line 4, Col 16, Line 4, Col 17, "The field 'B' appears multiple times in this record expression or pattern")
444+
Error 668, Line 4, Col 25, Line 4, Col 32, "The field 'B' appears multiple times in this record expression or pattern"
445445
]
446446

447447
[<Fact>]
@@ -454,8 +454,8 @@ module RecordTypes =
454454
|> typecheck
455455
|> shouldFail
456456
|> withDiagnostics [
457-
(Error 668, Line 4, Col 16, Line 4, Col 17, "The field 'B' appears multiple times in this record expression or pattern")
458-
(Error 668, Line 4, Col 25, Line 4, Col 26, "The field 'B' appears multiple times in this record expression or pattern")
457+
Error 668, Line 4, Col 25, Line 4, Col 32, "The field 'B' appears multiple times in this record expression or pattern"
458+
Error 668, Line 4, Col 34, Line 4, Col 41, "The field 'B' appears multiple times in this record expression or pattern"
459459
]
460460

461461
[<Fact>]
@@ -468,8 +468,8 @@ module RecordTypes =
468468
|> typecheck
469469
|> shouldFail
470470
|> withDiagnostics [
471-
(Error 668, Line 4, Col 16, Line 4, Col 17, "The field 'A' appears multiple times in this record expression or pattern")
472-
(Error 668, Line 4, Col 23, Line 4, Col 24, "The field 'B' appears multiple times in this record expression or pattern")
471+
Error 668, Line 4, Col 30, Line 4, Col 35, "The field 'A' appears multiple times in this record expression or pattern"
472+
Error 668, Line 4, Col 37, Line 4, Col 42, "The field 'B' appears multiple times in this record expression or pattern"
473473
]
474474

475475
[<Fact>]
@@ -482,7 +482,7 @@ module RecordTypes =
482482
|> typecheck
483483
|> shouldFail
484484
|> withDiagnostics [
485-
(Error 668, Line 4, Col 16, Line 4, Col 17, "The field 'A' appears multiple times in this record expression or pattern")
485+
Error 668, Line 4, Col 31, Line 4, Col 36, "The field 'A' appears multiple times in this record expression or pattern"
486486
]
487487

488488
[<Fact>]
@@ -495,8 +495,8 @@ module RecordTypes =
495495
|> typecheck
496496
|> shouldFail
497497
|> withDiagnostics [
498-
(Error 668, Line 4, Col 16, Line 4, Col 17, "The field 'A' appears multiple times in this record expression or pattern")
499-
(Error 668, Line 4, Col 31, Line 4, Col 32, "The field 'A' appears multiple times in this record expression or pattern")
498+
Error 668, Line 4, Col 31, Line 4, Col 36, "The field 'A' appears multiple times in this record expression or pattern"
499+
Error 668, Line 4, Col 45, Line 4, Col 50, "The field 'A' appears multiple times in this record expression or pattern"
500500
]
501501

502502
[<Fact>]
@@ -509,8 +509,8 @@ module RecordTypes =
509509
|> typecheck
510510
|> shouldFail
511511
|> withDiagnostics [
512-
(Error 668, Line 4, Col 16, Line 4, Col 21, "The field 'A' appears multiple times in this record expression or pattern")
513-
(Error 668, Line 4, Col 27, Line 4, Col 28, "The field 'B' appears multiple times in this record expression or pattern")
512+
Error 668, Line 4, Col 34, Line 4, Col 39, "The field 'A' appears multiple times in this record expression or pattern"
513+
Error 668, Line 4, Col 41, Line 4, Col 46, "The field 'B' appears multiple times in this record expression or pattern"
514514
]
515515

516516
[<Fact>]

‎tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module Language.CopyAndUpdateTests
1+
module Language.CopyAndUpdateTests
22

33
open Xunit
44
open FSharp.Test.Compiler
@@ -17,7 +17,7 @@ let t2 x = { x with D.B = "a"; D.B = "b" }
1717
|> typecheck
1818
|> shouldFail
1919
|> withDiagnostics [
20-
(Error 668, Line 6, Col 23, Line 6, Col 24, "The field 'B' appears multiple times in this record expression or pattern")
20+
Error 668, Line 6, Col 34, Line 6, Col 41, "The field 'B' appears multiple times in this record expression or pattern"
2121
]
2222

2323
[<Fact>]
@@ -32,8 +32,8 @@ let t2 x = { x with D.B = "a"; D.B = "b"; D.B = "c" }
3232
|> typecheck
3333
|> shouldFail
3434
|> withDiagnostics [
35-
(Error 668, Line 6, Col 23, Line 6, Col 24, "The field 'B' appears multiple times in this record expression or pattern")
36-
(Error 668, Line 6, Col 34, Line 6, Col 35, "The field 'B' appears multiple times in this record expression or pattern")
35+
Error 668, Line 6, Col 34, Line 6, Col 41, "The field 'B' appears multiple times in this record expression or pattern"
36+
Error 668, Line 6, Col 45, Line 6, Col 52, "The field 'B' appears multiple times in this record expression or pattern"
3737
]
3838

3939
[<Fact>]
@@ -48,8 +48,8 @@ let t2 x = { x with D.B = "a"; D.C = ""; D.B = "c" ; D.C = "d" }
4848
|> typecheck
4949
|> shouldFail
5050
|> withDiagnostics [
51-
(Error 668, Line 6, Col 34, Line 6, Col 35, "The field 'C' appears multiple times in this record expression or pattern")
52-
(Error 668, Line 6, Col 23, Line 6, Col 24, "The field 'B' appears multiple times in this record expression or pattern")
51+
Error 668, Line 6, Col 44, Line 6, Col 51, "The field 'B' appears multiple times in this record expression or pattern"
52+
Error 668, Line 6, Col 56, Line 6, Col 63, "The field 'C' appears multiple times in this record expression or pattern"
5353
]
5454

5555
[<Fact>]

‎tests/FSharp.Compiler.ComponentTests/Language/Nullness/NullableReferenceTypesTests.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1012,7 +1012,7 @@ myNullReturningFunction myValOfY |> ignore
10121012
|> withDiagnostics
10131013
[Error 3261, Line 17, Col 25, Line 17, Col 34, "Nullness warning: The type 'string' does not support 'null'."
10141014
Error 193, Line 19, Col 26, Line 19, Col 45, "The type 'System.DateTime' does not have 'null' as a proper value"
1015-
Error 1, Line 20, Col 25, Line 20, Col 36, "The type '{| Anon: 'a |}' does not have 'null' as a proper value"
1015+
Error 1, Line 20, Col 25, Line 20, Col 36, "The type '{| Anon: int |}' does not have 'null' as a proper value"
10161016
Error 1, Line 21, Col 26, Line 21, Col 31, "The type ''a * 'b * 'c' does not have 'null' as a proper value"
10171017
Error 1, Line 23, Col 25, Line 23, Col 33, "The type 'Y' does not have 'null' as a proper value"]
10181018

0 commit comments

Comments
 (0)