[Git][ghc/ghc][master] Add SpliceTypes test for hie files

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Oct 19 14:49:06 UTC 2022



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
1fab9598 by Matthew Pickering at 2022-10-19T10:48:29-04:00
Add SpliceTypes test for hie files

This test checks that typed splices and quotes get the right type
information when used in hiefiles.

See #21619

- - - - -


3 changed files:

- + testsuite/tests/hiefile/should_run/SpliceTypes.hs
- + testsuite/tests/hiefile/should_run/SpliceTypes.stdout
- testsuite/tests/hiefile/should_run/all.T


Changes:

=====================================
testsuite/tests/hiefile/should_run/SpliceTypes.hs
=====================================
@@ -0,0 +1,47 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main where
+
+import TestUtils
+import qualified Data.Map as M
+import Data.Foldable
+import Language.Haskell.TH.Syntax
+
+
+newtype T = T { getT :: Int }
+
+instance Lift T where
+  liftTyped v = [||T $$(liftTyped (getT v))||]
+--              ^  ^  ^     ^           ^
+--              1  2  3     4           5
+--
+
+top_level :: ()
+top_level = $$([|| () ||])
+--               ^  ^
+--               1  2
+
+p1,p2, p3, p4:: (Int,Int)
+p1 = (14,18)
+p2 = (14,21)
+p3 = (14,24)
+p4 = (14,29)
+p5 = (14,41)
+
+q1 = (20, 19)
+q2 = (20, 21)
+
+selectPoint' :: HieFile -> (Int,Int) -> HieAST Int
+selectPoint' hf loc =
+  maybe (error "point not found") id $ selectPoint hf loc
+
+main = do
+  (df, hf) <- readTestHie "SpliceTypes.hie"
+  forM_ [p1,p2,p3, p4, p5, q1, q2] $ \point -> do
+    let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point
+    case types of
+      [] -> putStrLn $ "No types at " ++ show point
+      _ -> do
+        putStr $ "At " ++ show point ++ ", got type: "
+        forM_ types $ \typ -> do
+          putStrLn (renderHieType df $ recoverFullType typ (hie_types hf))


=====================================
testsuite/tests/hiefile/should_run/SpliceTypes.stdout
=====================================
@@ -0,0 +1,9 @@
+No types at (14,18)
+At (14,21), got type: Int -> T
+No types at (14,24)
+At (14,29), got type: Int -> Code m Int
+forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
+forall (m :: * -> *). Quote m => Int -> Code m Int
+At (14,41), got type: T
+No types at (20,19)
+No types at (20,21)


=====================================
testsuite/tests/hiefile/should_run/all.T
=====================================
@@ -2,3 +2,4 @@ test('PatTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestU
 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'])
 test('RecordDotTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
+test('SpliceTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fab959843a27a3acfa04b435241688cad3ab713

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fab959843a27a3acfa04b435241688cad3ab713
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221019/31bb86b3/attachment-0001.html>


More information about the ghc-commits mailing list