diff --git a/src/Compiler/Checking/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs index 23dc7aa7748..f96093bfcec 100644 --- a/src/Compiler/Checking/TailCallChecks.fs +++ b/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 diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs index 9b512c5d7e2..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 @@ -412,6 +412,67 @@ 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 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`` () = """ @@ -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." } ] + + [] + 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`` () =