From 2f7487e6cae63d716ee636aa1a5e8ee60bfbf840 Mon Sep 17 00:00:00 2001
From: wz1000 <zubin.duggal@gmail.com>
Date: Sat, 10 Oct 2020 01:33:28 +0530
Subject: [PATCH] Add test for th link failure (#853)

---
 test/data/TH/THB.hs |  1 -
 test/exe/Main.hs    | 29 ++++++++++++++++++++++++++++-
 2 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/test/data/TH/THB.hs b/test/data/TH/THB.hs
index 2519ad8d6..8d50b01ea 100644
--- a/test/data/TH/THB.hs
+++ b/test/data/TH/THB.hs
@@ -3,4 +3,3 @@ module THB where
 import THA
 
 $th_a
-
diff --git a/test/exe/Main.hs b/test/exe/Main.hs
index efe26123f..c10051758 100644
--- a/test/exe/Main.hs
+++ b/test/exe/Main.hs
@@ -2470,6 +2470,7 @@ thTests =
         return ()
     , ignoreInWindowsForGHC88 (thReloadingTest `xfail` "expect broken (#672)")
     -- Regression test for https://github.com/digital-asset/ghcide/issues/614
+    , thLinkingTest `xfail` "expect broken"
     , testSessionWait "findsTHIdentifiers" $ do
         let sourceA =
               T.unlines
@@ -2509,7 +2510,7 @@ thReloadingTest = testCase "reloading-th-test" $ withoutStackEnv $ runWithExtraF
         bPath = dir </> "THB.hs"
         cPath = dir </> "THC.hs"
 
-    aSource <- liftIO $ readFileUtf8 aPath --  th = [d|a :: ()|]
+    aSource <- liftIO $ readFileUtf8 aPath --  th = [d|a = ()|]
     bSource <- liftIO $ readFileUtf8 bPath --  $th
     cSource <- liftIO $ readFileUtf8 cPath --  c = a :: ()
 
@@ -2535,6 +2536,32 @@ thReloadingTest = testCase "reloading-th-test" $ withoutStackEnv $ runWithExtraF
     closeDoc bdoc
     closeDoc cdoc
 
+thLinkingTest :: TestTree
+thLinkingTest = testCase "th-linking-test" $ withoutStackEnv $ runWithExtraFiles "TH" $ \dir -> do
+
+    let aPath = dir </> "THA.hs"
+        bPath = dir </> "THB.hs"
+
+    aSource <- liftIO $ readFileUtf8 aPath --  th_a = [d|a :: ()|]
+    bSource <- liftIO $ readFileUtf8 bPath --  $th_a
+
+    adoc <- createDoc aPath "haskell" aSource
+    bdoc <- createDoc bPath "haskell" bSource
+
+    expectDiagnostics [("THB.hs", [(DsWarning, (4,0), "Top-level binding")])]
+
+    let aSource' = T.unlines $ init (init (T.lines aSource)) ++ ["th :: DecsQ", "th = [d| a = False|]"]
+    changeDoc adoc [TextDocumentContentChangeEvent Nothing Nothing aSource']
+
+    -- modify b too
+    let bSource' = T.unlines $ init (T.lines bSource) ++ ["$th"]
+    changeDoc bdoc [TextDocumentContentChangeEvent Nothing Nothing bSource']
+
+    expectDiagnostics [("THB.hs", [(DsWarning, (4,0), "Top-level binding")])]
+
+    closeDoc adoc
+    closeDoc bdoc
+
 
 completionTests :: TestTree
 completionTests