Fix nested copy-and-update with complex original expressions

src/Compiler/Checking/CheckExpressions.fs

@@ -5643,11 +5643,17 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
         TcNonControlFlowExpr env <| fun env ->
         TcExprTuple cenv overallTy env tpenv (isExplicitStruct, args, m)
 
-    | SynExpr.AnonRecd (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr, _) ->
-        TcNonControlFlowExpr env <| fun env ->
-        TcPossiblyPropagatingExprLeafThenConvert (fun ty -> isAnonRecdTy g ty || isTyparTy g ty) cenv overallTy env mWholeExpr (fun overallTy ->
-            TcAnonRecdExpr cenv overallTy env tpenv (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr)
-        )
+    | SynExpr.AnonRecd (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr, trivia) ->
+        match withExprOpt with
+        | None
+        | Some(SynExpr.Ident _, _) ->
+            TcNonControlFlowExpr env <| fun env ->
+            TcPossiblyPropagatingExprLeafThenConvert (fun ty -> isAnonRecdTy g ty || isTyparTy g ty) cenv overallTy env mWholeExpr (fun overallTy ->
+                TcAnonRecdExpr cenv overallTy env tpenv (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr)
+            )
+        | Some withExpr ->
+            BindOriginalRecdExpr withExpr (fun withExpr -> SynExpr.AnonRecd (isStruct, withExpr, unsortedFieldExprs, mWholeExpr, trivia))
+            |> TcExpr cenv overallTy env tpenv
 
     | SynExpr.ArrayOrList (isArray, args, m) ->
         TcNonControlFlowExpr env <| fun env ->
@@ -5673,8 +5679,14 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
         TcExprObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, mNewExpr, m)
 
     | SynExpr.Record (inherits, withExprOpt, synRecdFields, mWholeExpr) ->
-        TcNonControlFlowExpr env <| fun env ->
-        TcExprRecord cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr)
+        match withExprOpt with
+        | None
+        | Some(SynExpr.Ident _, _) ->
+            TcNonControlFlowExpr env <| fun env ->
+            TcExprRecord cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr)
+        | Some withExpr ->
+            BindOriginalRecdExpr withExpr (fun withExpr -> SynExpr.Record (inherits, withExpr, synRecdFields, mWholeExpr))
+            |> TcExpr cenv overallTy env tpenv
 
     | SynExpr.While (spWhile, synGuardExpr, synBodyExpr, m) ->
         TcExprWhileLoop cenv overallTy env tpenv (spWhile, synGuardExpr, synBodyExpr, m)

src/Compiler/Checking/CheckRecordSyntaxHelpers.fs

@@ -11,6 +11,9 @@ open FSharp.Compiler.SyntaxTreeOps
 open FSharp.Compiler.Text.Position
 open FSharp.Compiler.Text.Range
 open FSharp.Compiler.TypedTree
+open FSharp.Compiler.Xml
+open FSharp.Compiler.SyntaxTrivia
+open TypedTreeOps
 
 /// Merges updates to nested record fields on the same level in record copy-and-update.
 ///
@@ -146,3 +149,29 @@ let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid
 
         (accessIds, outerFieldId),
         Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) outerFieldId rest exprBeingAssigned)
+
+/// When the original expression in copy-and-update is more complex than `{ x with ... }`, like `{ f () with ... }`,
+/// we bind it first, so that it's not evaluated multiple times during a nested update
+let BindOriginalRecdExpr (withExpr: SynExpr * BlockSeparator) mkRecdExpr =
+    let originalExpr, blockSep = withExpr
+    let mOrigExprSynth = originalExpr.Range.MakeSynthetic()
+    let id = mkSynId mOrigExprSynth "bind@"
+    let withExpr = SynExpr.Ident id, blockSep
+
+    let binding =
+        mkSynBinding
+            (PreXmlDoc.Empty, mkSynPatVar None id)
+            (None,
+             false,
+             false,
+             mOrigExprSynth,
+             DebugPointAtBinding.NoneAtSticky,
+             None,
+             originalExpr,
+             mOrigExprSynth,
+             [],
+             [],
+             None,
+             SynBindingTrivia.Zero)
+
+    SynExpr.LetOrUse(false, false, [ binding ], mkRecdExpr (Some withExpr), mOrigExprSynth, SynExprLetOrUseTrivia.Zero)

src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi

@@ -3,7 +3,6 @@
 module internal FSharp.Compiler.CheckRecordSyntaxHelpers
 
 open FSharp.Compiler.CheckBasics
-open FSharp.Compiler.NameResolution
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
 open FSharp.Compiler.TypedTree
@@ -19,3 +18,6 @@ val TransformAstForNestedUpdates<'a> :
     exprBeingAssigned: SynExpr ->
     withExpr: SynExpr * (range * 'a) ->
         (Ident list * Ident) * SynExpr option
+
+val BindOriginalRecdExpr:
+    withExpr: SynExpr * BlockSeparator -> mkRecdExpr: ((SynExpr * BlockSeparator) option -> SynExpr) -> SynExpr

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

@@ -423,4 +423,62 @@ let t7 (x: {| a: int; b: NestdRecTy |}) = {| x with c.D = "a" |}
         (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'.")
-    ]
+    ]
+
+[<Fact>]
+let ``Nested copy-and-update works when the starting expression is not a simple identifier``() =
+    FSharp """
+module CopyAndUpdateTests
+
+type Record1 = { Foo: int; Bar: int; }
+
+[<AutoOpen>]
+module Module =
+    type Record2 = { Foo: Record1; G: string }
+    let item: Record2 = Unchecked.defaultof<Record2>
+
+ignore { Module.item with Foo.Foo = 3 }
+    """
+    |> withLangVersion80
+    |> typecheck
+    |> shouldSucceed
+
+[<Fact>]
+let ``Nested, anonymous copy-and-update works when the starting expression is not a simple identifier``() =
+    FSharp """
+module CopyAndUpdateTests
+
+type Record1 = { Foo: int; Bar: int; }
+
+[<AutoOpen>]
+module Module =
+    let item = {| Foo = Unchecked.defaultof<Record1> |}
+
+ignore {| Module.item with Foo.Foo = 3 |}
+    """
+    |> withLangVersion80
+    |> typecheck
+    |> shouldSucceed
+
+[<Fact>]
+let ``Nested copy-and-update evaluates the original expression once``() =
+    FSharp """
+module CopyAndUpdateTests
+
+type Record1 = { Foo: int; Bar: int; Baz: string }
+type Record2 = { Foo: Record1; A: int; B: int }
+
+let f () =
+    printf "once"
+    { A = 1; B = 2; Foo = { Foo = 99; Bar = 98; Baz = "a" } }
+
+let actual = { f () with Foo.Foo = 3; Foo.Baz = "b"; A = -1 }
+
+let expected = { A = -1; B = 2; Foo = { Foo = 3; Bar = 98; Baz = "b" } }
+
+if actual <> expected then
+    failwith "actual does not equal expected"
+    """
+    |> withLangVersion80
+    |> compileExeAndRun
+    |> verifyOutput "once"