summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorColten Webb <coltenwebb@gmail.com>2022-07-15 07:54:39 -0500
committerZubin Duggal <zubin.duggal@gmail.com>2022-07-19 15:21:49 +0530
commitb2d4feb47cec2c48d44f6960c11301e925880452 (patch)
tree12e8d63548d3f6f23a9c0758116dfde4befb0876
parent11441162f41bebd86c7d9da0c1924799e4ac4e1a (diff)
downloadhaskell-b2d4feb47cec2c48d44f6960c11301e925880452.tar.gz
Add record-dot-syntax test
(cherry picked from commit 89d169ec0c4e9c1e6cf4a6373a1992dad7474d55)
-rw-r--r--testsuite/tests/hiefile/should_run/RecordDotTypes.hs43
-rw-r--r--testsuite/tests/hiefile/should_run/RecordDotTypes.stdout5
-rw-r--r--testsuite/tests/hiefile/should_run/TestUtils.hs41
-rw-r--r--testsuite/tests/hiefile/should_run/all.T1
4 files changed, 90 insertions, 0 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..382e7e6428
--- /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 (LlvmConfig [] [])
+
+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..884d58c31f 100644
--- a/testsuite/tests/hiefile/should_run/all.T
+++ b/testsuite/tests/hiefile/should_run/all.T
@@ -1,3 +1,4 @@
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('RecordDotTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])