Add record-dot-syntax test

(cherry picked from commit 89d169ec0c4e9c1e6cf4a6373a1992dad7474d55)

4 files changed, 94 insertions, 2 deletions

diff --git a/testsuite/tests/hiefile/should_run/RecordDotTypes.hs b/testsuite/tests/hiefile/should_run/RecordDotTypes.hs
new file mode 100644
index 0000000000..18f1ee33d9
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/RecordDotTypes.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NoFieldSelectors #-}
+
+module Main where
+
+import TestUtils
+import qualified Data.Map as M
+import Data.Foldable
+
+data MyRecord = MyRecord
+  { a :: String
+  , b :: Integer
+  , c :: MyChild
+  } deriving (Eq, Show)
+
+newtype MyChild = MyChild
+  { z :: String
+  } deriving (Eq, Show)
+
+x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } }
+y = x.a ++ show x.b ++ x.c.z
+--  ^             ^    ^  ^^
+--  1             2    3  45
+
+p1,p2,p3,p4 :: (Int,Int)
+p1 = (22,6)
+p2 = (22,20)
+p3 = (22,25)
+p4 = (22,28)
+p5 = (22,29)
+
+selectPoint' :: HieFile -> (Int,Int) -> HieAST Int
+selectPoint' hf loc =
+  maybe (error "point not found") id $ selectPoint hf loc
+
+main = do
+  (df, hf) <- readTestHie "RecordDotTypes.hie"
+  forM_ [p1,p2,p3,p4,p5] $ \point -> do
+    putStr $ "At " ++ show point ++ ", got type: "
+    let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point
+    forM_ types $ \typ -> do
+      putStrLn (renderHieType df $ recoverFullType typ (hie_types hf))
diff --git a/testsuite/tests/hiefile/should_run/RecordDotTypes.stdout b/testsuite/tests/hiefile/should_run/RecordDotTypes.stdout
new file mode 100644
index 0000000000..ad144fe5b8
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/RecordDotTypes.stdout
@@ -0,0 +1,5 @@
+At (22,6), got type: MyRecord
+At (22,20), got type: Integer
+At (22,25), got type: MyRecord
+At (22,28), got type: String
+At (22,29), got type: String
\ No newline at end of file
diff --git a/testsuite/tests/hiefile/should_run/TestUtils.hs b/testsuite/tests/hiefile/should_run/TestUtils.hs
new file mode 100644
index 0000000000..892574ff7e
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/TestUtils.hs
@@ -0,0 +1,43 @@
+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 = do
+  uniq_supply <- mkSplitUniqSupply 'z'
+  pure $ initNameCache uniq_supply []
+
+dynFlagsForPrinting :: String -> IO DynFlags
+dynFlagsForPrinting libdir = do
+  systemSettings <- initSysTools libdir
+  return $ defaultDynFlags systemSettings (LlvmConfig [] [])
+
+readTestHie :: FilePath -> IO (DynFlags, HieFile)
+readTestHie fp = do
+  libdir:_ <- getArgs
+  df <- dynFlagsForPrinting libdir
+  nc <- makeNc
+  hfr <- readHieFile (NCU (\f -> pure $ snd $ f 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 55dc8d1722..51463c54ea 100644
--- a/testsuite/tests/hiefile/should_run/all.T
+++ b/testsuite/tests/hiefile/should_run/all.T
@@ -1,2 +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('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('RecordDotTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])