From 7d6641af5185b84ecde364d4ec6ded2014b75f26 Mon Sep 17 00:00:00 2001
From: dawe <dawedawe@posteo.de>
Date: Wed, 22 Nov 2023 17:16:00 +0100
Subject: [PATCH 1/4] Check if we are in a TryWith/TryFinally operation, if
 yes, warn about non-tailrecursive calls

---
 src/Compiler/Checking/TailCallChecks.fs       |  33 +--
 .../ErrorMessages/TailCallAttribute.fs        | 217 ++++++++++++++++++
 2 files changed, 237 insertions(+), 13 deletions(-)

diff --git a/src/Compiler/Checking/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs
index 9371f59955b..a0d6fa21ded 100644
--- a/src/Compiler/Checking/TailCallChecks.fs
+++ b/src/Compiler/Checking/TailCallChecks.fs
@@ -728,37 +728,44 @@ and CheckBindings cenv binds =
         CheckBinding cenv false PermitByRefExpr.Yes bind
 
 let CheckModuleBinding cenv (isRec: bool) (TBind _ as bind) =
-    // Check that a let binding to the result of a rec expression is not inside the rec expression
+    // Check if a let binding to the result of a rec expression is not inside the rec expression
+    // Check if a call of a rec expression is not inside a TryWith/TryFinally operation
     // see test ``Warn for invalid tailcalls in seq expression because of bind`` for an example
     // see test ``Warn successfully for rec call in binding`` for an example
+    // see test ``Warn for simple rec call in try-with`` for an example
     if cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage then
         match bind.Expr with
         | Expr.TyLambda (bodyExpr = bodyExpr)
         | Expr.Lambda (bodyExpr = bodyExpr) ->
-            let rec checkTailCall (insideSubBinding: bool) expr =
+            let rec checkTailCall (insideSubBindingOrTry: bool) expr =
                 match expr with
                 | Expr.Val (valRef = valRef; range = m) ->
-                    if isRec && insideSubBinding && cenv.mustTailCall.Contains valRef.Deref then
+                    if isRec && insideSubBindingOrTry && cenv.mustTailCall.Contains valRef.Deref then
                         warning (Error(FSComp.SR.chkNotTailRecursive valRef.DisplayName, m))
                 | Expr.App (funcExpr = funcExpr; args = argExprs) ->
-                    checkTailCall insideSubBinding funcExpr
-                    argExprs |> List.iter (checkTailCall insideSubBinding)
-                | Expr.Link exprRef -> checkTailCall insideSubBinding exprRef.Value
-                | Expr.Lambda (bodyExpr = bodyExpr) -> checkTailCall insideSubBinding bodyExpr
-                | Expr.DebugPoint (_debugPointAtLeafExpr, expr) -> checkTailCall insideSubBinding expr
+                    checkTailCall insideSubBindingOrTry funcExpr
+                    argExprs |> List.iter (checkTailCall insideSubBindingOrTry)
+                | Expr.Link exprRef -> checkTailCall insideSubBindingOrTry exprRef.Value
+                | Expr.Lambda (bodyExpr = bodyExpr) -> checkTailCall insideSubBindingOrTry bodyExpr
+                | Expr.DebugPoint (_debugPointAtLeafExpr, expr) -> checkTailCall insideSubBindingOrTry expr
                 | Expr.Let (binding = binding; bodyExpr = bodyExpr) ->
                     checkTailCall true binding.Expr
 
                     let warnForBodyExpr =
-                        match stripDebugPoints bodyExpr with
-                        | Expr.Op _ -> true // ToDo: too crude of a check?
-                        | _ -> false
+                        insideSubBindingOrTry
+                        || match stripDebugPoints bodyExpr with
+                           | Expr.Op _ -> true
+                           | _ -> false
 
                     checkTailCall warnForBodyExpr bodyExpr
                 | Expr.Match (targets = decisionTreeTargets) ->
                     decisionTreeTargets
-                    |> Array.iter (fun target -> checkTailCall insideSubBinding target.TargetExpression)
-                | Expr.Op (args = exprs) -> exprs |> Seq.iter (checkTailCall insideSubBinding)
+                    |> Array.iter (fun target -> checkTailCall insideSubBindingOrTry target.TargetExpression)
+                | Expr.Op (args = exprs; op = TOp.TryWith _)
+                | Expr.Op (args = exprs; op = TOp.TryFinally _) ->
+                    // warn for recursive calls in TryWith/TryFinally operations
+                    exprs |> Seq.iter (checkTailCall true)
+                | Expr.Op (args = exprs) -> exprs |> Seq.iter (checkTailCall insideSubBindingOrTry)
                 | _ -> ()
 
             checkTailCall false bodyExpr
diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
index 9b512c5d7e2..ca8e243a265 100644
--- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
+++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
@@ -915,6 +915,223 @@ namespace N
               Message =
                 "The member or function 'loop' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
         ]
+
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for simple rec call in try-with`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec gTryWith x =
+            try
+                gTryWith (x + 1)
+            with e ->
+                raise (System.InvalidOperationException("Operation has failed", e))
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 9
+                        StartColumn = 17
+                        EndLine = 9
+                        EndColumn = 25 }
+              Message =
+                "The member or function 'gTryWith' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+            { Error = Warning 3569
+              Range = { StartLine = 9
+                        StartColumn = 17
+                        EndLine = 9
+                        EndColumn = 33 }
+              Message =
+                "The member or function 'gTryWith' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
+
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for return! rec call in async try-with`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec gAsyncTryWith (x: int) : Async<int> = async {
+            try
+                return! gAsyncTryWith (x + 1)
+            with e ->
+                return raise (System.InvalidOperationException("Operation has failed", e))
+        }
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 9
+                        StartColumn = 25
+                        EndLine = 9
+                        EndColumn = 38 }
+              Message =
+                "The member or function 'gAsyncTryWith' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
+
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for rec call in match branch in try-finally`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec gTryFinallyMatch x =
+            try
+                match x with
+                | 0 -> x
+                | _ -> gTryFinallyMatch x
+            finally
+                ()
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 11
+                        StartColumn = 24
+                        EndLine = 11
+                        EndColumn = 40 }
+              Message =
+                "The member or function 'gTryFinallyMatch' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
+    
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for rec call in if-else branch in try-with`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec gTryWithIfElse x =
+            try
+                if (x = 0) then
+                    x
+                else gTryWithIfElse x
+            with e ->
+                System.Runtime.ExceptionServices.ExceptionDispatchInfo.Throw(e)
+                Unchecked.defaultof<_>
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 11
+                        StartColumn = 22
+                        EndLine = 11
+                        EndColumn = 36 }
+              Message =
+                "The member or function 'gTryWithIfElse' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
+        
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for rec call in match branch in try-with`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec factorialWithAccTryWith n accumulator =
+            try
+                match n with
+                | 0u | 1u -> accumulator
+                | _ -> factorialWithAccTryWith (n - 1u) (n * accumulator)
+            with e ->
+                System.Runtime.ExceptionServices.ExceptionDispatchInfo.Throw(e)
+                Unchecked.defaultof<_>
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 11
+                        StartColumn = 24
+                        EndLine = 11
+                        EndColumn = 47 }
+              Message =
+                "The member or function 'factorialWithAccTryWith' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
+
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for rec call in with`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec gWithRecCallInWith x =
+            try
+                failwith "foo"
+            with _ ->
+                match x with
+                | 0 -> x
+                | _ -> gWithRecCallInWith x
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 13
+                        StartColumn = 24
+                        EndLine = 13
+                        EndColumn = 42 }
+              Message =
+                "The member or function 'gWithRecCallInWith' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
+    
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for rec call in finally`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec gWithRecCallInFinally x =
+            try
+                failwith "foo"
+            finally
+                match x with
+                | 0 -> x
+                | _ -> gWithRecCallInFinally x
+                |> ignore
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 13
+                        StartColumn = 24
+                        EndLine = 13
+                        EndColumn = 45 }
+              Message =
+                "The member or function 'gWithRecCallInFinally' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
     
     [<FSharp.Test.FactForNETCOREAPP>]
     let ``Don't warn for Continuation Passing Style func using [<TailCall>] func in continuation lambda`` () =

From 36d20f7131e85d4fa4d4b2f9e48620937560e1bf Mon Sep 17 00:00:00 2001
From: dawe <dawedawe@posteo.de>
Date: Wed, 22 Nov 2023 21:55:58 +0100
Subject: [PATCH 2/4] add test case for invalid tailcall in task expression

---
 .../ErrorMessages/TailCallAttribute.fs        | 28 +++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
index ca8e243a265..9182b5ccfaa 100644
--- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
+++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
@@ -412,6 +412,34 @@ namespace N
         |> compile
         |> shouldSucceed
 
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for return! rec call in task`` () =
+        """
+namespace N
+
+    module M =
+
+        [<TailCall>] 
+        let rec f x = task {
+            let y = x - 1
+            let z = y - 1
+            return! f (z - 1)
+        }
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 10
+                        StartColumn = 21
+                        EndLine = 10
+                        EndColumn = 22 }
+              Message =
+                "The member or function 'f' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
+
     [<FSharp.Test.FactForNETCOREAPP>]
     let ``Warn for invalid tailcalls in async expression`` () =
         """

From ff5c30110665bbe2816099bcf729d7d0c0bee237 Mon Sep 17 00:00:00 2001
From: dawe <dawedawe@posteo.de>
Date: Wed, 22 Nov 2023 22:32:56 +0100
Subject: [PATCH 3/4] add regression test for rec call in use scope

---
 .../ErrorMessages/TailCallAttribute.fs        | 33 +++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
index 9182b5ccfaa..33279650e1e 100644
--- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
+++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
@@ -440,6 +440,39 @@ namespace N
                 "The member or function 'f' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
         ]
 
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for rec call in use scope`` () =
+        """
+namespace N
+
+    module M =
+
+        [<TailCall>]
+        let rec f () =
+            use x = System.IO.File.OpenRead(@"C:\tmp\testfile")
+            f ()
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 9
+                        StartColumn = 13
+                        EndLine = 9
+                        EndColumn = 14 }
+              Message =
+                "The member or function 'f' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+            { Error = Warning 3569
+              Range = { StartLine = 9
+                        StartColumn = 13
+                        EndLine = 9
+                        EndColumn = 17 }
+              Message =
+                "The member or function 'f' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
+        ]
+
     [<FSharp.Test.FactForNETCOREAPP>]
     let ``Warn for invalid tailcalls in async expression`` () =
         """

From 3999b7f8759631c8b3747faef3960ec77d77ed97 Mon Sep 17 00:00:00 2001
From: dawe <dawedawe@posteo.de>
Date: Thu, 23 Nov 2023 11:48:12 +0100
Subject: [PATCH 4/4] fix namespace to appear in the right spot in test
 explorers

---
 .../ErrorMessages/TailCallAttribute.fs                          | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
index 33279650e1e..e516c1c8c35 100644
--- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
+++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
@@ -1,4 +1,4 @@
-namespace FSharp.Compiler.ComponentTests.ErrorMessages
+namespace ErrorMessages
 
 open FSharp.Test.Compiler
 open FSharp.Test.Compiler.Assertions.StructuredResultsAsserts
