From 4d835ad5c0323cbb0e2802e5dae494126f07a542 Mon Sep 17 00:00:00 2001
From: Scott Hutchinson <scotthutchinson@usa.net>
Date: Tue, 8 Dec 2020 11:18:24 -0800
Subject: [PATCH] Add cyclic check for struct tuple and tests

---
 src/fsharp/CheckDeclarations.fs               |  7 +-
 .../FSharp.Compiler.ComponentTests.fsproj     |  1 +
 .../TypeChecks/CheckDeclarationsTests.fs      | 96 +++++++++++++++++++
 3 files changed, 103 insertions(+), 1 deletion(-)
 create mode 100644 tests/FSharp.Compiler.ComponentTests/TypeChecks/CheckDeclarationsTests.fs

diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs
index dfc93ec46ea..abfe10f7015 100644
--- a/src/fsharp/CheckDeclarations.fs
+++ b/src/fsharp/CheckDeclarations.fs
@@ -4221,7 +4221,12 @@ module EstablishTypeDefinitionCores =
             and accStructFieldType structTycon structTyInst fspec fieldTy (doneTypes, acc) =
                 let fieldTy = stripTyparEqns fieldTy
                 match fieldTy with
-                | TType_app (tcref2, tinst2) when tcref2.IsStructOrEnumTycon ->
+                | TType_tuple (_isStruct , tinst2) when isStructTupleTy cenv.g fieldTy ->
+                    // The field is a struct tuple. Check each element of the tuple.
+                    // This case was added to resolve issues/3916
+                    ((doneTypes, acc), tinst2)
+                    ||> List.fold (fun acc' x -> accStructFieldType structTycon structTyInst fspec x acc')
+                | TType_app (tcref2 , tinst2) when tcref2.IsStructOrEnumTycon ->
                     // The field is a struct.
                     // An edge (tycon, tycon2) should be recorded, unless it is the "static self-typed field" case.
                     let tycon2 = tcref2.Deref
diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
index 3f8fc44becd..5bf85cacf7b 100644
--- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
+++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
@@ -51,6 +51,7 @@
     <Compile Include="Interop\SimpleInteropTests.fs" />
     <Compile Include="Interop\VisibilityTests.fs" />
     <Compile Include="Scripting\Interactive.fs" />
+    <Compile Include="TypeChecks\CheckDeclarationsTests.fs" />
   </ItemGroup>
 
   <ItemGroup>
diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/CheckDeclarationsTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/CheckDeclarationsTests.fs
new file mode 100644
index 00000000000..9330c00748a
--- /dev/null
+++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/CheckDeclarationsTests.fs
@@ -0,0 +1,96 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.ComponentTests.CheckDeclarationsTests
+
+open Xunit
+open FSharp.Test.Utilities.Compiler
+open FSharp.Test.Utilities.Xunit.Attributes
+
+module CheckDeclarationsTests =
+
+    [<Fact>]
+    let ``CheckingSyntacticTypes - TcTyconDefnCore_CheckForCyclicStructsAndInheritance - Struct DU with Cyclic Tuple`` () =
+        FSharp """
+namespace FSharpTest
+
+    [<Struct>]
+    type Tree =
+        | Empty
+        | Children of Tree * Tree
+"""
+        |> compile
+        |> shouldFail
+        |> withErrorCode 954
+        |> ignore
+
+    [<Fact>]
+    let ``CheckingSyntacticTypes - TcTyconDefnCore_CheckForCyclicStructsAndInheritance - Struct DU with Cyclic Struct Tuple`` () =
+        FSharp """
+namespace FSharpTest
+
+    [<Struct>]
+    type Tree =
+        | Empty
+        | Children of struct (Tree * Tree)
+"""
+        |> compile
+        |> shouldFail
+        |> withErrorCode 954
+        |> ignore
+
+    [<Fact>]
+    let ``CheckingSyntacticTypes - TcTyconDefnCore_CheckForCyclicStructsAndInheritance - Struct DU with Cyclic Struct Tuple of int, Tree`` () =
+        FSharp """
+namespace FSharpTest
+
+    [<Struct>]
+    type Tree =
+        | Empty
+        | Children of struct (int * Tree)
+"""
+        |> compile
+        |> shouldFail
+        |> withErrorCode 954
+        |> ignore
+
+    [<Fact>]
+    let ``CheckingSyntacticTypes - TcTyconDefnCore_CheckForCyclicStructsAndInheritance - Struct DU with Cyclic Tree`` () =
+        FSharp """
+namespace FSharpTest
+
+    [<Struct>]
+    type Tree =
+        | Empty
+        | Children of Tree
+"""
+        |> compile
+        |> shouldFail
+        |> withErrorCode 954
+        |> ignore
+
+    [<Fact>]
+    let ``CheckingSyntacticTypes - TcTyconDefnCore_CheckForCyclicStructsAndInheritance - Struct DU with Non-cyclic Struct Tuple`` () =
+        FSharp """
+namespace FSharpTest
+
+    [<Struct>]
+    type NotATree =
+        | Empty
+        | Children of struct (int * string)
+"""
+        |> compile
+        |> shouldSucceed
+        |> ignore
+
+    [<Fact>]
+    let ``CheckingSyntacticTypes - TcTyconDefnCore_CheckForCyclicStructsAndInheritance - Non-Struct DU Tree Cyclic Tree`` () =
+        FSharp """
+namespace FSharpTest
+
+    type Tree =
+        | Empty
+        | Children of Tree
+"""
+        |> compile
+        |> shouldSucceed
+        |> ignore