diff --git a/testsuite/tests/hiefile/should_run/HieQueries.hs b/testsuite/tests/hiefile/should_run/HieQueries.hs
index d6b7bba1b06127e22578f61e74bfba276404b416..199115e2a11a38f9e0e34bc8fd93d60576e77585 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 d352cc9c386bfea24fcc527e3673d53e5ca44425..11fc74a84f973db84fc734fbec7e0e620837a75c 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 e943a27cb112bd2a548a7e4e37fa6ef8646a575e..1db73c84616e8acfe5dc03b8858f28540bafbde1 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 e86d3cc12adb293245f76868e77205199f723ca8..f5d0d1891ee6306954d06311149b91f302778d3b 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 22b0c1a564800ff75b34bcd3b1c6ddd5241bff67..0434d52b38d6d5c4b7fda01a568adea3722e3d3b 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 45b31bd95e3c9af941e32ad58607989ab0580d80..bc2a37670fbf22a6373cd4f8ea2250856e2a08ba 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 0000000000000000000000000000000000000000..ec5d75e73f6823fe8d4f8b6774d79df4368e9f07
--- /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 f734e3c12e84b6229435424bd3af65bbd37b8786..7e258efbc6f985fd916a2e4166e320f5c4411eba 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'])