Fix missing TailCall warnings in TryWith/TryFinally

src/Compiler/Checking/TailCallChecks.fs

@@ -727,37 +727,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

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
@@ -412,6 +412,67 @@ 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 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`` () =
         """
@@ -915,6 +976,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`` () =