Fix bug preventing information about patterns from being serialized in .hie files

6 files changed, 87 insertions, 0 deletions

diff --git a/testsuite/tests/hiefile/should_compile/Scopes.hs b/testsuite/tests/hiefile/should_compile/Scopes.hs
new file mode 100644
index 0000000000..e3cbd8558f
--- /dev/null
+++ b/testsuite/tests/hiefile/should_compile/Scopes.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE RecordWildCards #-}
+module Scopes where
+data T = C { x :: Int, y :: Char }
+
+-- Verify that names generated from record construction are in scope
+foo = C { x = 1 , y = 'a' }
+
+-- Verify that record wildcards are in scope
+sdaf :: T
+sdaf = C{..}
+  where
+    x = 1
+    y = 'a'
diff --git a/testsuite/tests/hiefile/should_compile/Scopes.stderr b/testsuite/tests/hiefile/should_compile/Scopes.stderr
new file mode 100644
index 0000000000..f31d37d99f
--- /dev/null
+++ b/testsuite/tests/hiefile/should_compile/Scopes.stderr
@@ -0,0 +1,2 @@
+Got valid scopes
+Got no roundtrip errors
diff --git a/testsuite/tests/hiefile/should_compile/all.T b/testsuite/tests/hiefile/should_compile/all.T
index fb8092df95..fe0d6d74eb 100644
--- a/testsuite/tests/hiefile/should_compile/all.T
+++ b/testsuite/tests/hiefile/should_compile/all.T
@@ -11,3 +11,4 @@ test('hie009',       normal,                   compile, ['-fno-code -fwrite-ide-
 test('hie010',       normal,                   compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
 test('CPP',          normal,                   compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
 test('Constructors', normal,                   compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
+test('Scopes',       normal,                   compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
diff --git a/testsuite/tests/hiefile/should_run/PatTypes.hs b/testsuite/tests/hiefile/should_run/PatTypes.hs
new file mode 100644
index 0000000000..af5c42defa
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/PatTypes.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+
+import System.Environment
+
+import NameCache
+import SrcLoc
+import UniqSupply
+import Name
+
+import HieBin
+import HieTypes
+import HieUtils
+
+import DynFlags
+import SysTools
+
+import qualified Data.Map as M
+import Data.Foldable
+
+foo :: Maybe Char -> Char
+foo Nothing = 'a'
+--  1^
+foo (Just c) | c == 'a' =  c
+-- 2^    3^
+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 = do
+  uniq_supply <- mkSplitUniqSupply 'z'
+  return $ initNameCache uniq_supply []
+
+dynFlagsForPrinting :: String -> IO DynFlags
+dynFlagsForPrinting libdir = do
+  systemSettings <- initSysTools libdir
+  return $ defaultDynFlags systemSettings ([], [])
+
+selectPoint :: HieFile -> (Int,Int) -> HieAST Int
+selectPoint hf (sl,sc) = case M.toList (getAsts $ hie_asts hf) of
+    [(fs,ast)] ->
+      case selectSmallestContaining (sp fs) ast of
+        Nothing -> error "point not found"
+        Just ast' -> ast'
+    _ -> error "map should only contain a single AST"
+ where
+   sloc fs = mkRealSrcLoc fs sl sc
+   sp fs = mkRealSrcSpan (sloc fs) (sloc fs)
+
+main = do
+  libdir:_ <- getArgs
+  df <- dynFlagsForPrinting libdir
+  nc <- makeNc
+  (hfr, nc') <- readHieFile nc "PatTypes.hie"
+  let hf = hie_file_result hfr
+  forM_ [p1,p2,p3,p4] $ \point -> do
+    putStr $ "At " ++ show point ++ ", got type: "
+    let types = nodeType $ nodeInfo $ selectPoint hf point
+    forM_ types $ \typ -> do
+      putStrLn (renderHieType df $ recoverFullType typ (hie_types hf))
diff --git a/testsuite/tests/hiefile/should_run/PatTypes.stdout b/testsuite/tests/hiefile/should_run/PatTypes.stdout
new file mode 100644
index 0000000000..e86d3cc12a
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/PatTypes.stdout
@@ -0,0 +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
diff --git a/testsuite/tests/hiefile/should_run/all.T b/testsuite/tests/hiefile/should_run/all.T
new file mode 100644
index 0000000000..738dadcbe5
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/all.T
@@ -0,0 +1 @@
+test('PatTypes', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc -fwrite-ide-info'])