From 6bbde58191c7f9c30f57284006db5178f74fdd31 Mon Sep 17 00:00:00 2001
From: Vasily Sterekhov <89035-ryndubei@users.noreply.gitlab.haskell.org>
Date: Thu, 22 Jun 2023 03:39:50 +0100
Subject: [PATCH] Add test for #23540
`T23540.hs` makes use of `explainEv` from `HieQueries.hs`, so
`explainEv` has been moved to `TestUtils.hs`.
---
.../tests/hiefile/should_run/HieQueries.hs | 19 --
testsuite/tests/hiefile/should_run/T23540.hs | 111 +++++++++
.../tests/hiefile/should_run/T23540.stdout | 234 ++++++++++++++++++
.../tests/hiefile/should_run/TestUtils.hs | 21 +-
testsuite/tests/hiefile/should_run/all.T | 1 +
5 files changed, 366 insertions(+), 20 deletions(-)
create mode 100644 testsuite/tests/hiefile/should_run/T23540.hs
create mode 100644 testsuite/tests/hiefile/should_run/T23540.stdout
diff --git a/testsuite/tests/hiefile/should_run/HieQueries.hs b/testsuite/tests/hiefile/should_run/HieQueries.hs
index 199115e2a11a..bc56b87c3445 100644
--- a/testsuite/tests/hiefile/should_run/HieQueries.hs
+++ b/testsuite/tests/hiefile/should_run/HieQueries.hs
@@ -33,22 +33,3 @@ main = do
explainEv df hf refmap point
explainEv df hf refmap point'
return ()
-
-explainEv :: DynFlags -> HieFile -> RefMap Int -> (Int,Int) -> IO ()
-explainEv df hf refmap point = do
- putStrLn $ replicate 26 '='
- putStrLn $ "At point " ++ show point ++ ", we found:"
- putStrLn $ replicate 26 '='
- putStr $ drawForest ptrees
- where
- trees = getEvidenceTreesAtPoint hf refmap point
-
- ptrees = fmap (pprint . fmap expandType) <$> trees
-
- expandType = text . renderHieType df .
- flip recoverFullType (hie_types hf)
-
- pretty = unlines . (++["└"]) . ("┌":) . map ("│ "++) . lines
-
- pprint = pretty . render df
-
diff --git a/testsuite/tests/hiefile/should_run/T23540.hs b/testsuite/tests/hiefile/should_run/T23540.hs
new file mode 100644
index 000000000000..4dd35268eeb6
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/T23540.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE OverloadedLists, TypeFamilies, ApplicativeDo, NPlusKPatterns #-}
+
+module Main where
+
+import TestUtils
+import GHC.IsList ( IsList(..) )
+
+data Modulo1 = Zero deriving (Eq, Ord, Enum)
+
+instance Num Modulo1 where
+ fromInteger _ = Zero
+ (+) _ _ = Zero
+
+zero :: Modulo1
+zero = 0
+ -- ^ 1
+
+data Identity a = Identity a
+
+instance Functor Identity where
+ fmap f (Identity x) = Identity (f x)
+instance Applicative Identity where
+ pure = Identity
+ Identity f <*> Identity x = Identity (f x)
+instance Monad Identity where
+ Identity x >>= f = f x
+
+foo :: Identity Integer
+foo = do
+ _x <- Identity 1
+ -- ^ 2
+ Identity 2
+
+data BetterList x = Nil | Cons x (BetterList x)
+
+instance IsList (BetterList x) where
+ type Item (BetterList x) = x
+ fromList = foldr Cons Nil
+ toList Nil = []
+ toList (Cons x xs) = x : toList xs
+
+list :: BetterList Modulo1
+list = [0, 1, 2, 3, Zero]
+ -- ^ 3 ^ 4 ^ 5
+
+data Letter = A | B | C deriving Enum
+
+letters :: [Letter]
+letters = [A .. C]
+ -- ^ 6
+
+data Identity' a = Identity' a
+
+instance Functor Identity' where
+ fmap f (Identity' x) = Identity' (f x)
+instance Applicative Identity' where
+ pure = Identity'
+ Identity' f <*> Identity' x = Identity' (f x)
+
+bar :: Identity' Integer
+bar = do
+ -- ^ 7
+ a <- Identity' 1
+ b <- Identity' 2
+ pure (a + b)
+
+isZero :: Modulo1 -> Bool
+isZero n = case n of
+ 0 -> True
+-- ^ 8
+ _ -> False
+
+instance Real Modulo1 where
+ toRational _ = 0
+
+instance Integral Modulo1 where
+ toInteger _ = 0
+ quotRem _ _ = (0, 0)
+
+isPlusOne :: Modulo1 -> Bool
+isPlusOne n = case n of
+ (a + 1) -> True
+ -- ^ 9
+ _ -> False
+
+point1, point2, point3, point4, point5, point6, point7, point8, point9 :: (Int, Int)
+point1 = (15, 8)
+
+point2 = (30, 8)
+
+point3 = (43, 8)
+
+point4 = (43, 15)
+
+point5 = (43, 21)
+
+point6 = (49, 14)
+
+point7 = (61, 7)
+
+point8 = (69, 4)
+
+point9 = (82, 6)
+
+points :: [(Int, Int)]
+points = [point1, point2, point3, point4, point5, point6, point7, point8, point9]
+
+main = do
+ (df, hf) <- readTestHie "T23540.hie"
+ let refmap = generateReferencesMap . getAsts $ hie_asts hf
+ mapM_ (explainEv df hf refmap) points
diff --git a/testsuite/tests/hiefile/should_run/T23540.stdout b/testsuite/tests/hiefile/should_run/T23540.stdout
new file mode 100644
index 000000000000..778922b532ef
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/T23540.stdout
@@ -0,0 +1,234 @@
+==========================
+At point (15,8), we found:
+==========================
+┌
+│ $dNum at T23540.hs:1:1, of type: Num Modulo1
+│ is an evidence variable bound by a let, depending on: [$dNum]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $dNum at T23540.hs:1:1, of type: Num Modulo1
+ │ is an evidence variable bound by a let, depending on: [$fNumModulo1]
+ │ with scope: ModuleScope
+ │
+ │ Defined at <no location info>
+ â””
+ |
+ `- ┌
+ │ $fNumModulo1 at T23540.hs:10:10-20, of type: Num Modulo1
+ │ is an evidence variable bound by an instance of class Num
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:10:10
+ â””
+
+==========================
+At point (30,8), we found:
+==========================
+┌
+│ $dMonad at T23540.hs:1:1, of type: Monad Identity
+│ is an evidence variable bound by a let, depending on: [$fMonadIdentity]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $fMonadIdentity at T23540.hs:25:10-23, of type: Monad Identity
+ │ is an evidence variable bound by an instance of class Monad
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:25:10
+ â””
+
+==========================
+At point (43,8), we found:
+==========================
+┌
+│ $dIsList at T23540.hs:1:1, of type: IsList (BetterList Modulo1)
+│ is an evidence variable bound by a let, depending on: [$fIsListBetterList]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $fIsListBetterList at T23540.hs:36:10-30, of type: forall x. IsList (BetterList x)
+ │ is an evidence variable bound by an instance of class IsList
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:36:10
+ â””
+
+==========================
+At point (43,15), we found:
+==========================
+┌
+│ $dNum at T23540.hs:1:1, of type: Num Modulo1
+│ is an evidence variable bound by a let, depending on: [$dNum]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $dNum at T23540.hs:1:1, of type: Num Modulo1
+ │ is an evidence variable bound by a let, depending on: [$fNumModulo1]
+ │ with scope: ModuleScope
+ │
+ │ Defined at <no location info>
+ â””
+ |
+ `- ┌
+ │ $fNumModulo1 at T23540.hs:10:10-20, of type: Num Modulo1
+ │ is an evidence variable bound by an instance of class Num
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:10:10
+ â””
+
+==========================
+At point (43,21), we found:
+==========================
+==========================
+At point (49,14), we found:
+==========================
+┌
+│ $dEnum at T23540.hs:1:1, of type: Enum (Item [Letter])
+│ is an evidence variable bound by a let, depending on: [$dEnum]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $dEnum at T23540.hs:1:1, of type: Enum Letter
+ │ is an evidence variable bound by a let, depending on: [$fEnumLetter]
+ │ with scope: ModuleScope
+ │
+ │ Defined at <no location info>
+ â””
+ |
+ `- ┌
+ │ $fEnumLetter at T23540.hs:46:34-37, of type: Enum Letter
+ │ is an evidence variable bound by an instance of class Enum
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:46:34
+ â””
+
+==========================
+At point (61,7), we found:
+==========================
+┌
+│ $dFunctor at T23540.hs:1:1, of type: Functor Identity'
+│ is an evidence variable bound by a let, depending on: [$fFunctorIdentity']
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $fFunctorIdentity' at T23540.hs:54:10-26, of type: Functor Identity'
+ │ is an evidence variable bound by an instance of class Functor
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:54:10
+ â””
+
+┌
+│ $dApplicative at T23540.hs:1:1, of type: Applicative Identity'
+│ is an evidence variable bound by a let, depending on: [$fApplicativeIdentity']
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $fApplicativeIdentity' at T23540.hs:56:10-30, of type: Applicative Identity'
+ │ is an evidence variable bound by an instance of class Applicative
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:56:10
+ â””
+
+==========================
+At point (69,4), we found:
+==========================
+┌
+│ $dEq at T23540.hs:1:1, of type: Eq Modulo1
+│ is an evidence variable bound by a let, depending on: [$fEqModulo1]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $fEqModulo1 at T23540.hs:8:31-32, of type: Eq Modulo1
+ │ is an evidence variable bound by an instance of class Eq
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:8:31
+ â””
+
+┌
+│ $dNum at T23540.hs:1:1, of type: Num Modulo1
+│ is an evidence variable bound by a let, depending on: [$dNum]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $dNum at T23540.hs:1:1, of type: Num Modulo1
+ │ is an evidence variable bound by a let, depending on: [$fNumModulo1]
+ │ with scope: ModuleScope
+ │
+ │ Defined at <no location info>
+ â””
+ |
+ `- ┌
+ │ $fNumModulo1 at T23540.hs:10:10-20, of type: Num Modulo1
+ │ is an evidence variable bound by an instance of class Num
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:10:10
+ â””
+
+==========================
+At point (82,6), we found:
+==========================
+┌
+│ $dOrd at T23540.hs:1:1, of type: Ord Modulo1
+│ is an evidence variable bound by a let, depending on: [$fOrdModulo1]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $fOrdModulo1 at T23540.hs:8:35-37, of type: Ord Modulo1
+ │ is an evidence variable bound by an instance of class Ord
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:8:35
+ â””
+
+┌
+│ $dNum at T23540.hs:1:1, of type: Num Modulo1
+│ is an evidence variable bound by a let, depending on: [$fNumModulo1]
+│ with scope: ModuleScope
+│
+│ Defined at <no location info>
+â””
+|
+`- ┌
+ │ $fNumModulo1 at T23540.hs:10:10-20, of type: Num Modulo1
+ │ is an evidence variable bound by an instance of class Num
+ │ with scope: ModuleScope
+ │
+ │ Defined at T23540.hs:10:10
+ â””
\ No newline at end of file
diff --git a/testsuite/tests/hiefile/should_run/TestUtils.hs b/testsuite/tests/hiefile/should_run/TestUtils.hs
index 5ba0a3dc58a9..031fc28084a2 100644
--- a/testsuite/tests/hiefile/should_run/TestUtils.hs
+++ b/testsuite/tests/hiefile/should_run/TestUtils.hs
@@ -1,5 +1,6 @@
module TestUtils
- ( readTestHie
+ ( explainEv
+ , readTestHie
, render
, text
, SDoc
@@ -44,3 +45,21 @@ render df = renderWithContext (initSDocContext df defaultUserStyle) . ppr
text :: String -> SDoc
text = O.text -- SDoc-only version
+
+explainEv :: DynFlags -> HieFile -> RefMap Int -> (Int,Int) -> IO ()
+explainEv df hf refmap point = do
+ putStrLn $ replicate 26 '='
+ putStrLn $ "At point " ++ show point ++ ", we found:"
+ putStrLn $ replicate 26 '='
+ putStr $ drawForest ptrees
+ where
+ trees = getEvidenceTreesAtPoint hf refmap point
+
+ ptrees = fmap (pprint . fmap expandType) <$> trees
+
+ expandType = text . renderHieType df .
+ flip recoverFullType (hie_types hf)
+
+ pretty = unlines . (++["└"]) . ("┌":) . map ("│ "++) . lines
+
+ pprint = pretty . render df
diff --git a/testsuite/tests/hiefile/should_run/all.T b/testsuite/tests/hiefile/should_run/all.T
index 2628adb2ad31..98d19df01cd7 100644
--- a/testsuite/tests/hiefile/should_run/all.T
+++ b/testsuite/tests/hiefile/should_run/all.T
@@ -5,3 +5,4 @@ test('T23492', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti
test('RecordDotTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('SpliceTypes', [req_th, extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('HieVdq', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
+test('T23540', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
--
GitLab