From 7d6641af5185b84ecde364d4ec6ded2014b75f26 Mon Sep 17 00:00:00 2001 From: dawe 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 9371f59955..a0d6fa21de 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 9b512c5d7e..ca8e243a26 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." } ] + + [] + let ``Warn for simple rec call in try-with`` () = + """ +namespace N + + module M = + + [] + 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." } + ] + + [] + let ``Warn for return! rec call in async try-with`` () = + """ +namespace N + + module M = + + [] + let rec gAsyncTryWith (x: int) : Async = 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." } + ] + + [] + let ``Warn for rec call in match branch in try-finally`` () = + """ +namespace N + + module M = + + [] + 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." } + ] + + [] + let ``Warn for rec call in if-else branch in try-with`` () = + """ +namespace N + + module M = + + [] + 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." } + ] + + [] + let ``Warn for rec call in match branch in try-with`` () = + """ +namespace N + + module M = + + [] + 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." } + ] + + [] + let ``Warn for rec call in with`` () = + """ +namespace N + + module M = + + [] + 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." } + ] + + [] + let ``Warn for rec call in finally`` () = + """ +namespace N + + module M = + + [] + 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." } + ] [] let ``Don't warn for Continuation Passing Style func using [] func in continuation lambda`` () = From 36d20f7131e85d4fa4d4b2f9e48620937560e1bf Mon Sep 17 00:00:00 2001 From: dawe 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 ca8e243a26..9182b5ccfa 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 + [] + let ``Warn for return! rec call in task`` () = + """ +namespace N + + module M = + + [] + 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." } + ] + [] let ``Warn for invalid tailcalls in async expression`` () = """ From ff5c30110665bbe2816099bcf729d7d0c0bee237 Mon Sep 17 00:00:00 2001 From: dawe 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 9182b5ccfa..33279650e1 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." } ] + [] + let ``Warn for rec call in use scope`` () = + """ +namespace N + + module M = + + [] + 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." } + ] + [] let ``Warn for invalid tailcalls in async expression`` () = """ From 3999b7f8759631c8b3747faef3960ec77d77ed97 Mon Sep 17 00:00:00 2001 From: dawe 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 33279650e1..e516c1c8c3 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