- don't call destTopForallTy with wrong TType

- use GetValReprTypeInFSharpForm instead of GetTopTauTypeInFSharpForm - fixes dotnet#16330 - add regression tests
dawedawe · Nov 27, 2023 · 9b42d3c · 9b42d3c
1 parent 0f713ab
commit 9b42d3c
Show file tree

Hide file tree

Showing 2 changed files with 72 additions and 12 deletions.
diff --git a/src/Compiler/Checking/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs
@@ -35,10 +35,7 @@ type TailCall =
     static member private IsVoidRet (g: TcGlobals) (v: Val) =
         match v.ValReprInfo with
         | Some info ->
-            let _tps, tau = destTopForallTy g info v.Type
-
-            let _curriedArgInfos, returnTy =
-                GetTopTauTypeInFSharpForm g info.ArgInfos tau v.Range
+            let _, _, returnTy, _ = GetValReprTypeInFSharpForm g info v.Type v.Range
 
             if isUnitTy g returnTy then
                 TailCallReturnType.MustReturnVoid
@@ -168,16 +165,19 @@ and CheckForNonTailRecCall (cenv: cenv) expr (tailCall: TailCall) =
                             if vref.IsMemberOrModuleBinding && vref.ValReprInfo.IsSome then
                                 let topValInfo = vref.ValReprInfo.Value
 
-                                let (nowArgs, laterArgs), returnTy =
-                                    let _tps, tau = destTopForallTy g topValInfo _fty
-
-                                    let curriedArgInfos, returnTy =
-                                        GetTopTauTypeInFSharpForm cenv.g topValInfo.ArgInfos tau m
+                                let nowArgs, laterArgs =
+                                    let _, curriedArgInfos, _, _ =
+                                        GetValReprTypeInFSharpForm cenv.g topValInfo vref.Type m
 
                                     if argsl.Length >= curriedArgInfos.Length then
-                                        (List.splitAfter curriedArgInfos.Length argsl), returnTy
+                                        (List.splitAfter curriedArgInfos.Length argsl)
                                     else
-                                        ([], argsl), returnTy
+                                        ([], argsl)
+
+                                let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref
+
+                                let _, _, _, returnTy, _ =
+                                    GetValReprTypeInCompiledForm g topValInfo numEnclosingTypars vref.Type m
 
                                 let _, _, isNewObj, isSuperInit, isSelfInit, _, _, _ =
                                     GetMemberCallInfo cenv.g (vref, valUseFlags)
@@ -190,7 +190,7 @@ and CheckForNonTailRecCall (cenv: cenv) expr (tailCall: TailCall) =
                                 let hasByrefArg = nowArgs |> List.exists (tyOfExpr cenv.g >> isByrefTy cenv.g)
 
                                 let mustGenerateUnitAfterCall =
-                                    (isUnitTy g returnTy && returnType <> TailCallReturnType.MustReturnVoid)
+                                    (Option.isNone returnTy && returnType <> TailCallReturnType.MustReturnVoid)
 
                                 let noTailCallBlockers =
                                     not isNewObj

diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs
@@ -1193,7 +1193,67 @@ namespace N
               Message =
                 "The member or function 'gWithRecCallInFinally' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
         ]
+
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Warn for rec call inside of match lambda with closure over local function`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec f x y z =
+            let g x = x
+            function
+            | [] -> None
+            | h :: tail ->
+                h ()
+                f x (g y) z tail
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 13
+                        StartColumn = 17
+                        EndLine = 13
+                        EndColumn = 33 }
+              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 inside of match lambda with closure over local function using pipe`` () =
+        """
+namespace N
+
+    module M =
+    
+        [<TailCall>]
+        let rec f x y z =
+            let g x = x
+            function
+            | [] -> None
+            | h :: tail ->
+                h ()
+                tail |> f x (g y) z // using the pipe in this match lambda and closing over g caused FS0251 in 8.0 release, issue #16330
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldFail
+        |> withResults [
+            { Error = Warning 3569
+              Range = { StartLine = 13
+                        StartColumn = 17
+                        EndLine = 13
+                        EndColumn = 36 }
+              Message =
+                "The member or function 'f' 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`` () =
         """