Bugfix :: Sequence points

docs/release-notes/.FSharp.Compiler.Service/10.0.300.md

@@ -1,5 +1,9 @@
 ### Fixed
 
+* Fix extra sequence point at the end of match expressions. ([Issue #12052](https://github.com/dotnet/fsharp/issues/12052))
+* Fix wrong sequence point range for `return`/`yield`/`return!`/`yield!` inside computation expressions. ([Issue #19248](https://github.com/dotnet/fsharp/issues/19248))
+* Fix extra out-of-order sequence point for `use` in `task` computation expressions. ([Issue #19255](https://github.com/dotnet/fsharp/issues/19255))
+* Fix debug points failing to bind in body of `[ for x in xs -> body ]` comprehensions. ([Issue #13504](https://github.com/dotnet/fsharp/issues/13504))
 * Fixed Find All References not correctly finding active pattern cases in signature files. ([Issue #19173](https://github.com/dotnet/fsharp/issues/19173), [Issue #14969](https://github.com/dotnet/fsharp/issues/14969), [PR #19252](https://github.com/dotnet/fsharp/pull/19252))
 * Fixed Rename not correctly handling operators containing `.` (e.g., `-.-`). ([Issue #17221](https://github.com/dotnet/fsharp/issues/17221), [Issue #14057](https://github.com/dotnet/fsharp/issues/14057), [PR #19252](https://github.com/dotnet/fsharp/pull/19252))
 * Fixed Find All References not correctly applying `#line` directive remapping. ([Issue #9928](https://github.com/dotnet/fsharp/issues/9928), [PR #19252](https://github.com/dotnet/fsharp/pull/19252))

src/Compiler/Checking/Expressions/CheckComputationExpressions.fs

@@ -1893,6 +1893,7 @@ let rec TryTranslateComputationExpression
                                         headPat = pat
                                         expr = rhsExpr
                                         debugPoint = spBind
+                                        range = mBind
                                         trivia = { LeadingKeyword = leadingKeyword }) ]
                        Body = innerComp
                    },
@@ -1914,7 +1915,7 @@ let rec TryTranslateComputationExpression
                             None,
                             TranslateComputationExpressionNoQueryOps ceenv innerComp,
                             innerCompRange,
-                            DebugPointAtTarget.Yes,
+                            DebugPointAtTarget.No,
                             SynMatchClauseTrivia.Zero
                         )
                     ],
@@ -1925,7 +1926,7 @@ let rec TryTranslateComputationExpression
             requireBuilderMethod "Using" ceenv leadingKeyword.Range leadingKeyword.Range
 
             Some(
-                translatedCtxt (mkSynCall "Using" leadingKeyword.Range [ rhsExpr; consumeExpr ] ceenv.builderValName)
+                translatedCtxt (mkSynCall "Using" mBind [ rhsExpr; consumeExpr ] ceenv.builderValName)
                 |> addBindDebugPoint spBind
             )
 
@@ -2321,7 +2322,7 @@ let rec TryTranslateComputationExpression
 
             Some(translatedCtxt callExpr)
 
-        | SynExpr.YieldOrReturnFrom((true, _), synYieldExpr, _, { YieldOrReturnFromKeyword = m }) ->
+        | SynExpr.YieldOrReturnFrom((true, _), synYieldExpr, mFull, { YieldOrReturnFromKeyword = m }) ->
             let yieldFromExpr =
                 mkSourceExpr synYieldExpr ceenv.sourceMethInfo ceenv.builderValName
 
@@ -2343,11 +2344,11 @@ let rec TryTranslateComputationExpression
                 if IsControlFlowExpression synYieldExpr then
                     yieldFromCall
                 else
-                    SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, yieldFromCall)
+                    SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFull, false, yieldFromCall)
 
             Some(translatedCtxt yieldFromCall)
 
-        | SynExpr.YieldOrReturnFrom((false, _), synReturnExpr, _, { YieldOrReturnFromKeyword = m }) ->
+        | SynExpr.YieldOrReturnFrom((false, _), synReturnExpr, mFull, { YieldOrReturnFromKeyword = m }) ->
             let returnFromExpr =
                 mkSourceExpr synReturnExpr ceenv.sourceMethInfo ceenv.builderValName
 
@@ -2372,11 +2373,11 @@ let rec TryTranslateComputationExpression
                 if IsControlFlowExpression synReturnExpr then
                     returnFromCall
                 else
-                    SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnFromCall)
+                    SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFull, false, returnFromCall)
 
             Some(translatedCtxt returnFromCall)
 
-        | SynExpr.YieldOrReturn((isYield, _), synYieldOrReturnExpr, _, { YieldOrReturnKeyword = m }) ->
+        | SynExpr.YieldOrReturn((isYield, _), synYieldOrReturnExpr, mFull, { YieldOrReturnKeyword = m }) ->
             let methName = (if isYield then "Yield" else "Return")
 
             if ceenv.isQuery && not isYield then
@@ -2391,7 +2392,7 @@ let rec TryTranslateComputationExpression
                 if IsControlFlowExpression synYieldOrReturnExpr then
                     yieldOrReturnCall
                 else
-                    SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, yieldOrReturnCall)
+                    SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mFull, false, yieldOrReturnCall)
 
             Some(translatedCtxt yieldOrReturnCall)
 

src/Compiler/Checking/NameResolution.fs

@@ -2241,9 +2241,7 @@ let CallEnvSink (sink: TcResultsSink) (scopem, nenv, ad) =
     | None -> ()
     | Some sink -> sink.NotifyEnvWithScope(scopem, nenv, ad)
 
-// (#16621) Register union case tester properties as references to their underlying union case.
-// For union case testers (e.g., IsB property), this ensures "Find All References" on a union case
-// includes usages of its tester property. Uses a shifted range to avoid duplicate filtering in ItemKeyStore.
+// (#16621) Register union case tester properties (e.g., IsB) as references to their underlying union case.
 let RegisterUnionCaseTesterForProperty
     (sink: TcResultsSink)
     (m: range)
@@ -2278,7 +2276,7 @@ let CallNameResolutionSink (sink: TcResultsSink) (m: range, nenv, item, tpinst,
     | None -> ()
     | Some currentSink ->
         currentSink.NotifyNameResolution(m.End, item, tpinst, occurrenceType, nenv, ad, m, false)
-        // (#16621) For union case tester properties, also register the underlying union case
+
         match item with
         | Item.Property(_, pinfos, _) -> RegisterUnionCaseTesterForProperty sink m nenv pinfos occurrenceType ad
         | _ -> ()
@@ -2288,7 +2286,7 @@ let CallMethodGroupNameResolutionSink (sink: TcResultsSink) (m: range, nenv, ite
     | None -> ()
     | Some currentSink ->
         currentSink.NotifyMethodGroupNameResolution(m.End, item, itemMethodGroup, tpinst, occurrenceType, nenv, ad, m, false)
-        // (#16621) For union case tester properties, also register the underlying union case
+
         match item with
         | Item.Property(_, pinfos, _) -> RegisterUnionCaseTesterForProperty sink m nenv pinfos occurrenceType ad
         | _ -> ()

src/Compiler/Checking/NameResolution.fsi

@@ -628,10 +628,6 @@ val internal CallMethodGroupNameResolutionSink:
 val internal CallNameResolutionSinkReplacing:
     TcResultsSink -> range * NameResolutionEnv * Item * TyparInstantiation * ItemOccurrence * AccessorDomain -> unit
 
-/// (#16621) Register union case tester properties as references to their underlying union case
-val internal RegisterUnionCaseTesterForProperty:
-    TcResultsSink -> range -> NameResolutionEnv -> PropInfo list -> ItemOccurrence -> AccessorDomain -> unit
-
 /// Report a specific name resolution at a source range
 val internal CallExprHasTypeSink: TcResultsSink -> range * NameResolutionEnv * TType * AccessorDomain -> unit
 

src/Compiler/CodeGen/IlxGen.fs

@@ -3556,8 +3556,7 @@ and GenLinearExpr cenv cgbuf eenv expr sequel preSteps (contf: FakeUnit -> FakeU
                          //
                          // In both cases, any instructions that come after this point will be falsely associated with the last branch of the control
                          // prior to the join point. This is base, e.g. see FSharp 1.0 bug 5155
-                         if not (isNil stackAfterJoin) then
-                             cgbuf.EmitStartOfHiddenCode()
+                         cgbuf.EmitStartOfHiddenCode()
 
                          GenSequel cenv eenv.cloc cgbuf sequelAfterJoin
                          Fake))

src/Compiler/Optimize/LowerComputedCollections.fs

@@ -616,12 +616,12 @@ let gatherPrelude ((|App|_|) : _ -> _ voption) expr =
 [<return: Struct>]
 let (|SeqMap|_|) g =
     gatherPrelude (function
-        | ValApp g g.seq_map_vref ([ty1; ty2], [Expr.Lambda (valParams = [loopVal]; bodyExpr = body; range = mIn) as mapping; input], mFor) ->
+        | ValApp g g.seq_map_vref ([ty1; ty2], [Expr.Lambda (valParams = [loopVal]; bodyExpr = DebugPoints (body, debug); range = mIn) as mapping; input], mFor) ->
             let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No
             let spFor = DebugPointAtBinding.Yes mFor
             let spInWhile = match spIn with DebugPointAtInOrTo.Yes m -> DebugPointAtWhile.Yes m | DebugPointAtInOrTo.No -> DebugPointAtWhile.No
             let ranges = body.Range, spFor, spIn, mFor, mIn, spInWhile
-            ValueSome (ty1, ty2, input, mapping, loopVal, body, ranges)
+            ValueSome (ty1, ty2, input, mapping, loopVal, debug body, ranges)
 
         | _ -> ValueNone)
 

src/Compiler/SyntaxTree/PrettyNaming.fs

@@ -927,11 +927,9 @@ let splitAroundQuotationWithCount (text: string) (separator: char) (count: int)
 [<Literal>]
 let FSharpModuleSuffix = "Module"
 
-/// Prefix for union case tester properties (e.g., "get_IsCase" for union case "Case")
 [<Literal>]
 let unionCaseTesterPropertyPrefix = "get_Is"
 
-/// The length of unionCaseTesterPropertyPrefix
 [<Literal>]
 let unionCaseTesterPropertyPrefixLength = 6 // "get_Is".Length
 

src/Compiler/SyntaxTree/PrettyNaming.fsi

@@ -221,15 +221,12 @@ val internal FSharpModuleSuffix: string = "Module"
 [<Literal>]
 val internal MangledGlobalName: string = "`global`"
 
-/// Prefix for union case tester properties (e.g., "get_IsCase" for union case "Case")
 [<Literal>]
 val internal unionCaseTesterPropertyPrefix: string = "get_Is"
 
-/// The length of unionCaseTesterPropertyPrefix
 [<Literal>]
 val internal unionCaseTesterPropertyPrefixLength: int = 6
 
-/// Check if a property name is a union case tester property
 val internal IsUnionCaseTesterPropertyName: name: string -> bool
 
 val internal IllegalCharactersInTypeAndNamespaceNames: char[]

tests/AheadOfTime/Trimming/check.ps1

@@ -63,7 +63,7 @@ function CheckTrim($root, $tfm, $outputfile, $expected_len, $callerLineNumber) {
 $allErrors = @()
 
 # Check net9.0 trimmed assemblies
-$allErrors += CheckTrim -root "SelfContained_Trimming_Test" -tfm "net9.0" -outputfile "FSharp.Core.dll" -expected_len 311296 -callerLineNumber 66
+$allErrors += CheckTrim -root "SelfContained_Trimming_Test" -tfm "net9.0" -outputfile "FSharp.Core.dll" -expected_len 311808 -callerLineNumber 66
 
 # Check net9.0 trimmed assemblies with static linked FSharpCore
 $allErrors += CheckTrim -root "StaticLinkedFSharpCore_Trimming_Test" -tfm "net9.0" -outputfile "StaticLinkedFSharpCore_Trimming_Test.dll" -expected_len 9169408 -callerLineNumber 69

tests/FSharp.Compiler.ComponentTests/Debugger/CEDebugPoints.fs

@@ -0,0 +1,104 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Debugger
+
+open Xunit
+open FSharp.Test.Compiler
+open Debugger.DebuggerTestHelpers
+
+/// https://github.com/dotnet/fsharp/issues/19248
+/// https://github.com/dotnet/fsharp/issues/19255
+module CEDebugPoints =
+
+    [<Fact>]
+    let ``Return in async CE - debug point covers full expression`` () =
+        verifyMethodDebugPoints """
+module TestModule
+
+let a =
+    async {
+        return 1
+    }
+        """ "Invoke" [ (Line 6, Col 9, Line 6, Col 17) ]
+
+    [<Fact>]
+    let ``Yield in seq CE - debug point on yield value`` () =
+        verifyMethodDebugPoints """
+module TestModule
+
+let a =
+    seq {
+        yield 42
+    }
+        """ "GenerateNext" [ (Line 6, Col 15, Line 6, Col 17) ]
+
+    [<Fact>]
+    let ``ReturnFrom in async CE - debug point covers full expression`` () =
+        verifyMethodDebugPoints """
+module TestModule
+
+let a =
+    async {
+        return! async.Return(1)
+    }
+        """ "Invoke" [ (Line 6, Col 9, Line 6, Col 32) ]
+
+    [<Fact>]
+    let ``YieldFrom in CE - debug point covers full expression`` () =
+        verifyMethodDebugPoints """
+module TestModule
+
+type Wrapper<'a> = Wrapper of 'a list
+
+type ListBuilder() =
+    member _.Yield(x) = Wrapper [x]
+    member _.YieldFrom(Wrapper xs) = Wrapper xs
+    member _.Combine(Wrapper xs, Wrapper ys) = Wrapper(xs @ ys)
+    member _.Delay(f: unit -> Wrapper<'a>) = f()
+    member _.Zero() = Wrapper []
+
+let list = ListBuilder()
+
+let a =
+    list {
+        yield! Wrapper [1; 2]
+    }
+        """ "staticInitialization@" [ (Line 13, Col 1, Line 13, Col 25); (Line 16, Col 5, Line 16, Col 9); (Line 17, Col 9, Line 17, Col 30) ]
+
+    [<Fact>]
+    let ``Yield in task CE - debug point covers full expression`` () =
+        verifyMethodDebugPoints """
+module TestModule
+
+open System.Collections.Generic
+
+let mkValue () = 42
+
+let items = ResizeArray<int>()
+
+let t =
+    task {
+        items.Add(mkValue())
+        return ()
+    }
+        """ "MoveNext" [ (Line 12, Col 9, Line 12, Col 29); (Line 13, Col 9, Line 13, Col 18) ]
+
+    [<Fact>]
+    let ``Use in task CE - no extra out-of-order sequence point`` () =
+        verifyMethodDebugPoints """
+module TestModule
+
+open System
+open System.Threading.Tasks
+
+type Disposable() =
+    interface IDisposable with
+        member _.Dispose() = ()
+
+let t =
+    task {
+        let i = 1
+        use d = new Disposable()
+        return i
+    }
+        """ "MoveNext" [ (Line 14, Col 9, Line 14, Col 33); (Line 13, Col 9, Line 13, Col 18); (Line 14, Col 13, Line 14, Col 14); (Line 15, Col 9, Line 15, Col 17) ]

tests/FSharp.Compiler.ComponentTests/Debugger/DebuggerTestHelpers.fs

@@ -0,0 +1,31 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Debugger
+
+open FSharp.Test.Compiler
+
+module DebuggerTestHelpers =
+
+    let verifyMethodDebugPoints source methodName expectedSequencePoints =
+        FSharp source
+        |> asLibrary
+        |> withPortablePdb
+        |> compile
+        |> shouldSucceed
+        |> verifyPdb [ VerifyMethodSequencePoints(methodName, expectedSequencePoints) ]
+
+    let verifyAllSequencePoints source expectedSequencePoints =
+        FSharp source
+        |> asLibrary
+        |> withPortablePdb
+        |> compile
+        |> shouldSucceed
+        |> verifyPdb [ VerifySequencePoints expectedSequencePoints ]
+
+    let verifyMethodDebugPointsInRange source methodName startLine endLine =
+        FSharp source
+        |> asLibrary
+        |> withPortablePdb
+        |> compile
+        |> shouldSucceed
+        |> verifyPdb [ VerifyMethodSequencePointsInRange(methodName, startLine, endLine) ]

tests/FSharp.Compiler.ComponentTests/Debugger/ForArrowDebugPoints.fs

@@ -0,0 +1,61 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Debugger
+
+open Xunit
+open FSharp.Test.Compiler
+open Debugger.DebuggerTestHelpers
+
+/// https://github.com/dotnet/fsharp/issues/13504
+module ForArrowDebugPoints =
+
+    [<Fact>]
+    let ``For-arrow list comprehension body has debug point`` () =
+        verifyAllSequencePoints """
+module TestModule
+
+let squares = [
+    for x in [1; 2; 3] ->
+        x * x
+    ]
+        """ [
+            (Line 4, Col 1, Line 7, Col 6)
+            (Line 5, Col 5, Line 5, Col 8)
+            (Line 5, Col 11, Line 5, Col 13)
+            (Line 6, Col 9, Line 6, Col 14)
+            (Line 16707566, Col 0, Line 16707566, Col 0)
+        ]
+
+    [<Fact>]
+    let ``For-arrow array comprehension body has debug point`` () =
+        verifyAllSequencePoints """
+module TestModule
+
+let squares = [|
+    for x in [|1; 2; 3|] ->
+        x * x
+    |]
+        """ [
+            (Line 4, Col 1, Line 7, Col 7)
+            (Line 5, Col 5, Line 5, Col 8)
+            (Line 5, Col 11, Line 5, Col 13)
+            (Line 6, Col 9, Line 6, Col 14)
+            (Line 16707566, Col 0, Line 16707566, Col 0)
+        ]
+
+    [<Fact>]
+    let ``For-do-yield comprehension body has debug point`` () =
+        verifyAllSequencePoints """
+module TestModule
+
+let squares = [
+    for x in [1; 2; 3] do
+        yield x * x
+    ]
+        """ [
+            (Line 4, Col 1, Line 7, Col 6)
+            (Line 5, Col 5, Line 5, Col 8)
+            (Line 5, Col 11, Line 5, Col 13)
+            (Line 6, Col 15, Line 6, Col 20)
+            (Line 16707566, Col 0, Line 16707566, Col 0)
+        ]