testsuite: Factor out common parts from hiefile testswip/validate-ide-info-fixes

8 files changed, 104 insertions, 145 deletions

diff --git a/testsuite/tests/hiefile/should_run/HieQueries.hs b/testsuite/tests/hiefile/should_run/HieQueries.hs
index d6b7bba1b0..199115e2a1 100644
--- a/testsuite/tests/hiefile/should_run/HieQueries.hs
+++ b/testsuite/tests/hiefile/should_run/HieQueries.hs
@@ -1,22 +1,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Main where
 
-import System.Environment
-
-import GHC.Types.Name.Cache
-import GHC.Types.SrcLoc
-import GHC.Types.Unique.Supply
-import GHC.Types.Name
+import TestUtils
 import Data.Tree
-import GHC.Iface.Ext.Binary
-import GHC.Iface.Ext.Types
-import GHC.Iface.Ext.Utils
-import Data.Maybe (fromJust)
-import GHC.Driver.Session
-import GHC.SysTools
-import GHC.Utils.Outputable                 ( Outputable, renderWithContext, ppr, defaultUserStyle, text)
-import qualified Data.Map as M
-import Data.Foldable
 
 class C a where
   f :: a -> Char
@@ -31,31 +17,19 @@ foo :: C a => a -> Char
 foo x = f [x]
 --      ^ this is the point
 point :: (Int,Int)
-point = (31,9)
+point = (17,9)
 
 bar :: Show x => x -> String
 bar x = show [(1,x,A)]
 --      ^ this is the point'
 point' :: (Int,Int)
-point' = (37,9)
+point' = (23,9)
 
 data A = A deriving Show
 
-makeNc :: IO NameCache
-makeNc = initNameCache 'z' []
-
-dynFlagsForPrinting :: String -> IO DynFlags
-dynFlagsForPrinting libdir = do
-  systemSettings <- initSysTools libdir
-  return $ defaultDynFlags systemSettings
-
 main = do
-  libdir:_ <- getArgs
-  df <- dynFlagsForPrinting libdir
-  nc <- makeNc
-  hfr <- readHieFile nc "HieQueries.hie"
-  let hf = hie_file_result hfr
-      refmap = generateReferencesMap $ getAsts $ hie_asts hf
+  (df, hf) <- readTestHie "HieQueries.hie"
+  let refmap = generateReferencesMap $ getAsts $ hie_asts hf
   explainEv df hf refmap point
   explainEv df hf refmap point'
   return ()
@@ -76,5 +50,5 @@ explainEv df hf refmap point = do
 
     pretty = unlines . (++["└"]) . ("┌":) . map ("│ "++) . lines
 
-    pprint = pretty . renderWithContext (initSDocContext df sty) . ppr
-    sty = defaultUserStyle
+    pprint = pretty . render df
+
diff --git a/testsuite/tests/hiefile/should_run/HieQueries.stdout b/testsuite/tests/hiefile/should_run/HieQueries.stdout
index d352cc9c38..11fc74a84f 100644
--- a/testsuite/tests/hiefile/should_run/HieQueries.stdout
+++ b/testsuite/tests/hiefile/should_run/HieQueries.stdout
@@ -1,99 +1,99 @@
 ==========================
-At point (31,9), we found:
+At point (17,9), we found:
 ==========================
 ┌
-│ $dC at HieQueries.hs:31:1-13, of type: C [a]
+│ $dC at HieQueries.hs:17:1-13, of type: C [a]
 │     is an evidence variable bound by a let, depending on: [$fCList,
 │                                                            $dC]
-│           with scope: LocalScope HieQueries.hs:31:1-13
-│           bound at: HieQueries.hs:31:1-13
+│           with scope: LocalScope HieQueries.hs:17:1-13
+│           bound at: HieQueries.hs:17:1-13
 │     Defined at <no location info>
 └
 |
 +- ┌
-|  │ $fCList at HieQueries.hs:27:10-21, of type: forall a. C a => C [a]
+|  │ $fCList at HieQueries.hs:13:10-21, of type: forall a. C a => C [a]
 |  │     is an evidence variable bound by an instance of class C
 |  │           with scope: ModuleScope
 |  │           
-|  │     Defined at HieQueries.hs:27:10
+|  │     Defined at HieQueries.hs:13:10
 |  └
 |
 `- ┌
-   │ $dC at HieQueries.hs:31:1-13, of type: C a
+   │ $dC at HieQueries.hs:17:1-13, of type: C a
    │     is an evidence variable bound by a HsWrapper
-   │           with scope: LocalScope HieQueries.hs:31:1-13
-   │           bound at: HieQueries.hs:31:1-13
+   │           with scope: LocalScope HieQueries.hs:17:1-13
+   │           bound at: HieQueries.hs:17:1-13
    │     Defined at <no location info>
    └
 
 ==========================
-At point (37,9), we found:
+At point (23,9), we found:
 ==========================
 ┌
-│ $dShow at HieQueries.hs:37:1-22, of type: Show [(Integer, x, A)]
+│ $dShow at HieQueries.hs:23:1-22, of type: Show [(Integer, x, A)]
 │     is an evidence variable bound by a let, depending on: [$fShowList,
 │                                                            $dShow]
-│           with scope: LocalScope HieQueries.hs:37:1-22
-│           bound at: HieQueries.hs:37:1-22
+│           with scope: LocalScope HieQueries.hs:23:1-22
+│           bound at: HieQueries.hs:23:1-22
 │     Defined at <no location info>
 └
 |
 +- ┌
-|  │ $fShowList at HieQueries.hs:37:1-22, of type: forall a. Show a => Show [a]
+|  │ $fShowList at HieQueries.hs:23:1-22, of type: forall a. Show a => Show [a]
 |  │     is a usage of an external evidence variable
 |  │     Defined in `GHC.Show'
 |  └
 |
 `- ┌
-   │ $dShow at HieQueries.hs:37:1-22, of type: Show (Integer, x, A)
+   │ $dShow at HieQueries.hs:23:1-22, of type: Show (Integer, x, A)
    │     is an evidence variable bound by a let, depending on: [$fShow(,,),
    │                                                            $dShow, $dShow, $dShow]
-   │           with scope: LocalScope HieQueries.hs:37:1-22
-   │           bound at: HieQueries.hs:37:1-22
+   │           with scope: LocalScope HieQueries.hs:23:1-22
+   │           bound at: HieQueries.hs:23:1-22
    │     Defined at <no location info>
    └
    |
    +- ┌
-   |  │ $fShow(,,) at HieQueries.hs:37:1-22, of type: forall a b c. (Show a, Show b, Show c) => Show (a, b, c)
+   |  │ $fShow(,,) at HieQueries.hs:23:1-22, of type: forall a b c. (Show a, Show b, Show c) => Show (a, b, c)
    |  │     is a usage of an external evidence variable
    |  │     Defined in `GHC.Show'
    |  └
    |
    +- ┌
-   |  │ $dShow at HieQueries.hs:37:1-22, of type: Show Integer
+   |  │ $dShow at HieQueries.hs:23:1-22, of type: Show Integer
    |  │     is an evidence variable bound by a let, depending on: [$fShowInteger]
-   |  │           with scope: LocalScope HieQueries.hs:37:1-22
-   |  │           bound at: HieQueries.hs:37:1-22
+   |  │           with scope: LocalScope HieQueries.hs:23:1-22
+   |  │           bound at: HieQueries.hs:23:1-22
    |  │     Defined at <no location info>
    |  └
    |  |
    |  `- ┌
-   |     │ $fShowInteger at HieQueries.hs:37:1-22, of type: Show Integer
+   |     │ $fShowInteger at HieQueries.hs:23:1-22, of type: Show Integer
    |     │     is a usage of an external evidence variable
    |     │     Defined in `GHC.Show'
    |     └
    |
    +- ┌
-   |  │ $dShow at HieQueries.hs:37:1-22, of type: Show x
+   |  │ $dShow at HieQueries.hs:23:1-22, of type: Show x
    |  │     is an evidence variable bound by a HsWrapper
-   |  │           with scope: LocalScope HieQueries.hs:37:1-22
-   |  │           bound at: HieQueries.hs:37:1-22
+   |  │           with scope: LocalScope HieQueries.hs:23:1-22
+   |  │           bound at: HieQueries.hs:23:1-22
    |  │     Defined at <no location info>
    |  └
    |
    `- ┌
-      │ $dShow at HieQueries.hs:37:1-22, of type: Show A
+      │ $dShow at HieQueries.hs:23:1-22, of type: Show A
       │     is an evidence variable bound by a let, depending on: [$fShowA]
-      │           with scope: LocalScope HieQueries.hs:37:1-22
-      │           bound at: HieQueries.hs:37:1-22
+      │           with scope: LocalScope HieQueries.hs:23:1-22
+      │           bound at: HieQueries.hs:23:1-22
       │     Defined at <no location info>
       └
       |
       `- ┌
-         │ $fShowA at HieQueries.hs:42:21-24, of type: Show A
+         │ $fShowA at HieQueries.hs:28:21-24, of type: Show A
          │     is an evidence variable bound by an instance of class Show
          │           with scope: ModuleScope
          │           
-         │     Defined at HieQueries.hs:42:21
+         │     Defined at HieQueries.hs:28:21
          └
 
diff --git a/testsuite/tests/hiefile/should_run/PatTypes.hs b/testsuite/tests/hiefile/should_run/PatTypes.hs
index e943a27cb1..1db73c8461 100644
--- a/testsuite/tests/hiefile/should_run/PatTypes.hs
+++ b/testsuite/tests/hiefile/should_run/PatTypes.hs
@@ -1,20 +1,6 @@
-{-# LANGUAGE ScopedTypeVariables #-}
 module Main where
 
-import System.Environment
-
-import GHC.Types.Name.Cache
-import GHC.Types.SrcLoc
-import GHC.Types.Unique.Supply
-import GHC.Types.Name
-
-import GHC.Iface.Ext.Binary
-import GHC.Iface.Ext.Types
-import GHC.Iface.Ext.Utils
-
-import GHC.Driver.Session
-import GHC.SysTools
-
+import TestUtils
 import qualified Data.Map as M
 import Data.Foldable
 
@@ -27,29 +13,17 @@ foo x = 'b'
 -- 4^
 
 p1,p2,p3,p4 :: (Int,Int)
-p1 = (22,6)
-p2 = (24,5)
-p3 = (24,11)
-p4 = (26,5)
-
-makeNc :: IO NameCache
-makeNc = initNameCache 'z' []
-
-dynFlagsForPrinting :: String -> IO DynFlags
-dynFlagsForPrinting libdir = do
-  systemSettings <- initSysTools libdir
-  return $ defaultDynFlags systemSettings
+p1 = (8,6)
+p2 = (10,5)
+p3 = (10,11)
+p4 = (12,5)
 
 selectPoint' :: HieFile -> (Int,Int) -> HieAST Int
 selectPoint' hf loc =
   maybe (error "point not found") id $ selectPoint hf loc
 
 main = do
-  libdir:_ <- getArgs
-  df <- dynFlagsForPrinting libdir
-  nc <- makeNc
-  hfr <- readHieFile nc "PatTypes.hie"
-  let hf = hie_file_result hfr
+  (df, hf) <- readTestHie "PatTypes.hie"
   forM_ [p1,p2,p3,p4] $ \point -> do
     putStr $ "At " ++ show point ++ ", got type: "
     let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point
diff --git a/testsuite/tests/hiefile/should_run/PatTypes.stdout b/testsuite/tests/hiefile/should_run/PatTypes.stdout
index e86d3cc12a..f5d0d1891e 100644
--- a/testsuite/tests/hiefile/should_run/PatTypes.stdout
+++ b/testsuite/tests/hiefile/should_run/PatTypes.stdout
@@ -1,4 +1,4 @@
-At (22,6), got type: Maybe Char
-At (24,5), got type: Maybe Char
-At (24,11), got type: Char
-At (26,5), got type: Maybe Char
+At (8,6), got type: Maybe Char
+At (10,5), got type: Maybe Char
+At (10,11), got type: Char
+At (12,5), got type: Maybe Char
diff --git a/testsuite/tests/hiefile/should_run/T20341.hs b/testsuite/tests/hiefile/should_run/T20341.hs
index 22b0c1a564..0434d52b38 100644
--- a/testsuite/tests/hiefile/should_run/T20341.hs
+++ b/testsuite/tests/hiefile/should_run/T20341.hs
@@ -1,28 +1,13 @@
 {-# language DeriveAnyClass #-}
 {-# language DefaultSignatures #-}
-{-# language DeriveGeneric #-}
 
 module Main where
 
-import System.Environment
-import Data.Tree
-import GHC.Types.Name.Cache
-import GHC.Types.SrcLoc
-import GHC.Types.Unique.Supply
-import GHC.Types.Name
-import GHC.Utils.Outputable                 ( Outputable, renderWithContext, ppr, defaultUserStyle, text)
-import GHC.Iface.Ext.Binary
-import GHC.Iface.Ext.Types
-import GHC.Iface.Ext.Utils
-
-import GHC.Driver.Session
-import GHC.SysTools
-
+import TestUtils
 import qualified Data.Map as M
+import Data.Tree
 import Data.Foldable
 
-import GHC.Generics
-
 class ToJSON a where
   foo :: a -> String
   default foo :: Show a => a -> String
@@ -41,39 +26,24 @@ h = show (MkT True)
 --   ^ this is point'
 
 point :: (Int, Int)
-point = (36,6)
+point = (21,6)
 
 point' :: (Int, Int)
-point' = (40,6)
-
-makeNc :: IO NameCache
-makeNc = initNameCache 'z' []
-
-dynFlagsForPrinting :: String -> IO DynFlags
-dynFlagsForPrinting libdir = do
-  systemSettings <- initSysTools libdir
-  return $ defaultDynFlags systemSettings (LlvmConfig [] [])
+point' = (25,6)
 
 selectPoint' :: HieFile -> (Int,Int) -> HieAST Int
 selectPoint' hf loc =
   maybe (error "point not found") id $ selectPoint hf loc
 
 main = do
-  libdir:_ <- getArgs
-  df <- dynFlagsForPrinting libdir
-  nc <- makeNc
-  hfr <- readHieFile nc "T20341.hie"
-  let hf = hie_file_result hfr
-      asts = getAsts $ hie_asts hf
+  (df, hf) <- readTestHie "T20341.hie"
+  let asts = getAsts $ hie_asts hf
       [ast] = M.elems asts
       refmap = generateReferencesMap $ asts
       expandType = text . renderHieType df .
         flip recoverFullType (hie_types hf)
       pretty = unlines . (++["└"]) . ("┌":) . map ("│ "++) . lines
-      pprint = pretty . render
-      render :: forall a. Outputable a => a -> String
-      render = renderWithContext (initSDocContext df sty) . ppr
-      sty = defaultUserStyle
+      pprint = pretty . render df
   putStr $ "At " ++ show point ++ ", got evidence: "
   let trees = getEvidenceTreesAtPoint hf refmap point
       ptrees = fmap (pprint . fmap expandType) <$> trees
diff --git a/testsuite/tests/hiefile/should_run/T20341.stdout b/testsuite/tests/hiefile/should_run/T20341.stdout
index 45b31bd95e..bc2a37670f 100644
--- a/testsuite/tests/hiefile/should_run/T20341.stdout
+++ b/testsuite/tests/hiefile/should_run/T20341.stdout
@@ -1,4 +1,4 @@
-At (36,6), got evidence: ┌
+At (21,6), got evidence: ┌
 │ $dToJSON at T20341.hs:1:1, of type: ToJSON T
 │     is an evidence variable bound by a let, depending on: [$fToJSONT]
 │           with scope: ModuleScope
@@ -7,14 +7,14 @@ At (36,6), got evidence: ┌
 └
 |
 `- ┌
-   │ $fToJSONT at T20341.hs:32:19-24, of type: ToJSON T
+   │ $fToJSONT at T20341.hs:17:19-24, of type: ToJSON T
    │     is an evidence variable bound by an instance of class ToJSON
    │           with scope: ModuleScope
    │           
-   │     Defined at T20341.hs:32:19
+   │     Defined at T20341.hs:17:19
    └
 
-SrcSpanOneLine "T20341.hs" 32 19 25
+SrcSpanOneLine "T20341.hs" 17 19 25
 ┌
 │ $dShow at T20341.hs:1:1, of type: Show T
 │     is an evidence variable bound by a let, depending on: [$fShowT]
@@ -24,11 +24,11 @@ SrcSpanOneLine "T20341.hs" 32 19 25
 └
 |
 `- ┌
-   │ $fShowT at T20341.hs:32:13-16, of type: Show T
+   │ $fShowT at T20341.hs:17:13-16, of type: Show T
    │     is an evidence variable bound by an instance of class Show
    │           with scope: ModuleScope
    │           
-   │     Defined at T20341.hs:32:13
+   │     Defined at T20341.hs:17:13
    └
 
 $dShow was found in the definition of $fToJSONT
diff --git a/testsuite/tests/hiefile/should_run/TestUtils.hs b/testsuite/tests/hiefile/should_run/TestUtils.hs
new file mode 100644
index 0000000000..ec5d75e73f
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/TestUtils.hs
@@ -0,0 +1,41 @@
+module TestUtils
+  ( readTestHie
+  , render
+  , text
+  , DynFlags
+  , module GHC.Iface.Ext.Types
+  , module GHC.Iface.Ext.Utils
+  ) where
+
+import System.Environment
+import Data.Tree
+import GHC.Types.Name.Cache
+import GHC.Types.SrcLoc
+import GHC.Types.Unique.Supply
+import GHC.Types.Name
+import GHC.Utils.Outputable                 ( Outputable, renderWithContext, ppr, defaultUserStyle, text)
+import GHC.Iface.Ext.Binary
+import GHC.Iface.Ext.Types
+import GHC.Iface.Ext.Utils
+ 
+import GHC.Driver.Session
+import GHC.SysTools
+
+makeNc :: IO NameCache
+makeNc = initNameCache 'z' []
+ 
+dynFlagsForPrinting :: String -> IO DynFlags
+dynFlagsForPrinting libdir = do
+  systemSettings <- initSysTools libdir
+  return $ defaultDynFlags systemSettings
+
+readTestHie :: FilePath -> IO (DynFlags, HieFile)
+readTestHie fp = do
+  libdir:_ <- getArgs
+  df <- dynFlagsForPrinting libdir
+  nc <- makeNc
+  hfr <- readHieFile nc fp
+  pure (df, hie_file_result hfr)
+
+render :: Outputable a => DynFlags -> a -> String
+render df = renderWithContext (initSDocContext df defaultUserStyle) . ppr
diff --git a/testsuite/tests/hiefile/should_run/all.T b/testsuite/tests/hiefile/should_run/all.T
index f734e3c12e..7e258efbc6 100644
--- a/testsuite/tests/hiefile/should_run/all.T
+++ b/testsuite/tests/hiefile/should_run/all.T
@@ -1,3 +1,3 @@
-test('PatTypes', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc -fwrite-ide-info'])
-test('HieQueries', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc -fwrite-ide-info'])
-test('T20341', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc -fwrite-ide-info'])
+test('PatTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
+test('HieQueries', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
+test('T20341', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])