Add testcase T16804 for #16804

slightly larger testcase for :type-at and :uses
so we can see changes, if #16804 is done.

6 files changed, 415 insertions, 0 deletions

diff --git a/testsuite/tests/ghci/scripts/T16804.script b/testsuite/tests/ghci/scripts/T16804.script
new file mode 100644
index 0000000000..ec30ec1537
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16804.script
@@ -0,0 +1,150 @@
+let custom c s e = let cmd = c ++ " " ++ s ++ maybe "" (" " ++) e; in (putStrLn ("input: " ++ cmd) >> return cmd)
+
+let tp s = custom ":type-at" s (Just "undefined")
+let up s = custom ":uses" s Nothing
+let cp s = putStrLn s >> return ""
+
+let ruler p n = putStrLn $ replicate p ' ' ++ replicate (n * 10) ' ' ++ "1234567890"
+let putruler p s = ruler p 0 >> ruler p 1 >> ruler p 2 >> ruler p 3 >> return ""
+
+:def tp tp
+:def up up
+:def cp cp
+:def putruler1 (putruler 2)
+:def putruler2 (putruler 3)
+
+:set +c
+:l T16804a.hs T16804b.hs
+
+:cp  1 module T16804 where
+:putruler1
+
+:tp T16804a.hs  1  8  1 15
+:up T16804a.hs  1  8  1 15
+
+:cp  2 
+:cp  3 import Data.Monoid
+:putruler1
+
+:tp T16804a.hs  3  8  3 12
+:tp T16804a.hs  3  8  3 19
+
+:up T16804a.hs  3  8  3 12
+:up T16804a.hs  3  8  3 19
+
+:cp  4 
+:cp  5 data Test = A | B
+:cp  6   deriving (Show)
+:putruler1
+
+:tp T16804a.hs  5  6  5 10
+:tp T16804a.hs  5 13  5 14
+:tp T16804a.hs  5 15  5 16
+:tp T16804a.hs  5 17  5 18
+:tp T16804a.hs  6 13  6 17
+
+:up T16804a.hs  5  6  5 10
+:up T16804a.hs  5 13  5 14
+:up T16804a.hs  5 15  5 16
+:up T16804a.hs  5 17  5 18
+:up T16804a.hs  6 13  6 17
+
+:cp  7 instance Monoid Test where
+:cp  8   mempty = A
+:cp  9   -- gone 
+:cp 10   -- gone
+:putruler1
+:tp T16804a.hs  7 10  7 16 
+:tp T16804a.hs  7 17  7 21
+:tp T16804a.hs  7 10  7 21
+:tp T16804a.hs  8  3  8  9
+:tp T16804a.hs  8 12  8 13
+
+:up T16804a.hs  7 10  7 16 
+:up T16804a.hs  7 17  7 21
+:up T16804a.hs  7 10  7 21
+:up T16804a.hs  8  3  8  9
+:up T16804a.hs  8 12  8 13
+
+:cp 11  
+:cp 12 testFunction :: Test -> Test -> Bool
+:cp 13 testFunction A B = True
+:cp 14 testFunction B A = True
+:cp 15 testFunction _ _ = False
+:putruler2
+:tp T16804a.hs 12  1 12 13
+:tp T16804a.hs 13  1 13 13
+:tp T16804a.hs 13 14 13 15
+:tp T16804a.hs 13 16 13 17
+:tp T16804a.hs 15 16 15 17
+:tp T16804a.hs 15 20 15 25
+
+:up T16804a.hs 12  1 12 13
+:up T16804a.hs 13  1 13 13
+:up T16804a.hs 13 14 13 15
+:up T16804a.hs 13 16 13 17
+:up T16804a.hs 15 16 15 17
+:up T16804a.hs 15 20 15 25
+
+:cp 
+:cp 16  
+:cp 17 testFunction2 :: Bool -> Test
+:cp 18 testFunction2 True = A
+:cp 19 testFunction2 False = B
+:putruler2
+:tp T16804a.hs 18 15 18 19
+:tp T16804a.hs 18 22 18 23
+
+:up T16804a.hs 18 15 18 19
+:up T16804a.hs 18 22 18 23
+
+:cp 20  
+:cp 21 niceValue :: Int
+:cp 22 niceValue = getSum (Sum 1 <> Sum 2 <> mempty)
+:putruler2
+:tp T16804a.hs 22 13 22 19
+:tp T16804a.hs 22 21 22 24
+:tp T16804a.hs 22 25 22 26
+:tp T16804a.hs 22 21 22 26
+:tp T16804a.hs 22 27 22 29
+
+:up T16804a.hs 22 13 22 19
+:up T16804a.hs 22 21 22 24
+:up T16804a.hs 22 25 22 26
+:up T16804a.hs 22 21 22 26
+:up T16804a.hs 22 27 22 29
+
+:cp 23  
+:cp 24 niceValue2 :: Test
+:cp 25 niceValue2 = A <> A <> A <> B <> A <> mempty
+:putruler2
+:tp T16804a.hs 25 14 25 15
+:tp T16804a.hs 25 16 25 18
+:tp T16804a.hs 25 39 25 45
+
+:up T16804a.hs 25 14 25 15
+:up T16804a.hs 25 16 25 18
+:up T16804a.hs 25 39 25 45
+
+:cp 26
+:cp 27 instance Semigroup Test where
+:cp 28   A <> val = val
+:cp 29   B <> _   = B
+:putruler2
+:tp T16804a.hs 28  3 28  4
+:tp T16804a.hs 28  5 28  7
+:tp T16804a.hs 28  8 28 11
+:tp T16804a.hs 28 14 28 17
+:tp T16804a.hs 29  3 29  4
+:tp T16804a.hs 29  5 29  7
+:tp T16804a.hs 29  8 29  9
+:tp T16804a.hs 29 14 29 15
+
+:up T16804a.hs 28  3 28  4
+:up T16804a.hs 28  5 28  7
+:up T16804a.hs 28  8 28 11
+:up T16804a.hs 28 14 28 17
+:up T16804a.hs 29  3 29  4
+:up T16804a.hs 29  5 29  7
+:up T16804a.hs 29  8 29  9
+:up T16804a.hs 29 14 29 15
diff --git a/testsuite/tests/ghci/scripts/T16804.stderr b/testsuite/tests/ghci/scripts/T16804.stderr
new file mode 100644
index 0000000000..3d439200cb
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16804.stderr
@@ -0,0 +1,30 @@
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
+Couldn't resolve to any modules.
diff --git a/testsuite/tests/ghci/scripts/T16804.stdout b/testsuite/tests/ghci/scripts/T16804.stdout
new file mode 100644
index 0000000000..ddae235fc0
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16804.stdout
@@ -0,0 +1,194 @@
+Collecting type info for 2 module(s) ... 
+1 module T16804 where
+  1234567890
+            1234567890
+                      1234567890
+                                1234567890
+input: :type-at T16804a.hs  1  8  1 15 undefined
+undefined :: forall a. a
+input: :uses T16804a.hs  1  8  1 15
+2
+3 import Data.Monoid
+  1234567890
+            1234567890
+                      1234567890
+                                1234567890
+input: :type-at T16804a.hs  3  8  3 12 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs  3  8  3 19 undefined
+undefined :: forall a. a
+input: :uses T16804a.hs  3  8  3 12
+input: :uses T16804a.hs  3  8  3 19
+4
+5 data Test = A | B
+6   deriving (Show)
+  1234567890
+            1234567890
+                      1234567890
+                                1234567890
+input: :type-at T16804a.hs  5  6  5 10 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs  5 13  5 14 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs  5 15  5 16 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs  5 17  5 18 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs  6 13  6 17 undefined
+undefined :: [Test] -> ShowS
+input: :uses T16804a.hs  5  6  5 10
+input: :uses T16804a.hs  5 13  5 14
+input: :uses T16804a.hs  5 15  5 16
+input: :uses T16804a.hs  5 17  5 18
+input: :uses T16804a.hs  6 13  6 17
+T16804a.hs:(6,13)-(6,16)
+T16804a.hs:(6,13)-(6,16)
+7 instance Monoid Test where
+8   mempty = A
+9   -- gone
+10   -- gone
+  1234567890
+            1234567890
+                      1234567890
+                                1234567890
+input: :type-at T16804a.hs  7 10  7 16 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs  7 17  7 21 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs  7 10  7 21 undefined
+undefined :: [Test] -> Test
+input: :type-at T16804a.hs  8  3  8  9 undefined
+undefined :: Test
+input: :type-at T16804a.hs  8 12  8 13 undefined
+undefined :: Test
+input: :uses T16804a.hs  7 10  7 16
+input: :uses T16804a.hs  7 17  7 21
+input: :uses T16804a.hs  7 10  7 21
+T16804a.hs:(7,10)-(7,20)
+T16804a.hs:(7,10)-(7,20)
+input: :uses T16804a.hs  8  3  8  9
+T16804a.hs:(8,3)-(8,8)
+T16804a.hs:(8,3)-(8,8)
+input: :uses T16804a.hs  8 12  8 13
+11
+12 testFunction :: Test -> Test -> Bool
+13 testFunction A B = True
+14 testFunction B A = True
+15 testFunction _ _ = False
+   1234567890
+             1234567890
+                       1234567890
+                                 1234567890
+input: :type-at T16804a.hs 12  1 12 13 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs 13  1 13 13 undefined
+undefined :: Test -> Test -> Bool
+input: :type-at T16804a.hs 13 14 13 15 undefined
+undefined :: Test
+input: :type-at T16804a.hs 13 16 13 17 undefined
+undefined :: Test
+input: :type-at T16804a.hs 15 16 15 17 undefined
+undefined :: Test
+input: :type-at T16804a.hs 15 20 15 25 undefined
+undefined :: Bool
+input: :uses T16804a.hs 12  1 12 13
+input: :uses T16804a.hs 13  1 13 13
+T16804a.hs:(13,1)-(13,12)
+T16804a.hs:(13,1)-(13,12)
+input: :uses T16804a.hs 13 14 13 15
+input: :uses T16804a.hs 13 16 13 17
+input: :uses T16804a.hs 15 16 15 17
+input: :uses T16804a.hs 15 20 15 25
+
+16
+17 testFunction2 :: Bool -> Test
+18 testFunction2 True = A
+19 testFunction2 False = B
+   1234567890
+             1234567890
+                       1234567890
+                                 1234567890
+input: :type-at T16804a.hs 18 15 18 19 undefined
+undefined :: Bool
+input: :type-at T16804a.hs 18 22 18 23 undefined
+undefined :: Test
+input: :uses T16804a.hs 18 15 18 19
+input: :uses T16804a.hs 18 22 18 23
+20
+21 niceValue :: Int
+22 niceValue = getSum (Sum 1 <> Sum 2 <> mempty)
+   1234567890
+             1234567890
+                       1234567890
+                                 1234567890
+input: :type-at T16804a.hs 22 13 22 19 undefined
+undefined :: Sum Int -> Int
+input: :type-at T16804a.hs 22 21 22 24 undefined
+undefined :: Int -> Sum Int
+input: :type-at T16804a.hs 22 25 22 26 undefined
+undefined :: Int
+input: :type-at T16804a.hs 22 21 22 26 undefined
+undefined :: Sum Int
+input: :type-at T16804a.hs 22 27 22 29 undefined
+undefined :: Sum Int -> Sum Int -> Sum Int
+input: :uses T16804a.hs 22 13 22 19
+input: :uses T16804a.hs 22 21 22 24
+input: :uses T16804a.hs 22 25 22 26
+input: :uses T16804a.hs 22 21 22 26
+input: :uses T16804a.hs 22 27 22 29
+23
+24 niceValue2 :: Test
+25 niceValue2 = A <> A <> A <> B <> A <> mempty
+   1234567890
+             1234567890
+                       1234567890
+                                 1234567890
+input: :type-at T16804a.hs 25 14 25 15 undefined
+undefined :: Test
+input: :type-at T16804a.hs 25 16 25 18 undefined
+undefined :: Test -> Test -> Test
+input: :type-at T16804a.hs 25 39 25 45 undefined
+undefined :: Test
+input: :uses T16804a.hs 25 14 25 15
+input: :uses T16804a.hs 25 16 25 18
+input: :uses T16804a.hs 25 39 25 45
+26
+27 instance Semigroup Test where
+28   A <> val = val
+29   B <> _   = B
+   1234567890
+             1234567890
+                       1234567890
+                                 1234567890
+input: :type-at T16804a.hs 28  3 28  4 undefined
+undefined :: Test
+input: :type-at T16804a.hs 28  5 28  7 undefined
+undefined :: Test -> Test -> Test
+input: :type-at T16804a.hs 28  8 28 11 undefined
+undefined :: Test
+input: :type-at T16804a.hs 28 14 28 17 undefined
+undefined :: Test
+input: :type-at T16804a.hs 29  3 29  4 undefined
+undefined :: Test
+input: :type-at T16804a.hs 29  5 29  7 undefined
+undefined :: forall a. a
+input: :type-at T16804a.hs 29  8 29  9 undefined
+undefined :: Test
+input: :type-at T16804a.hs 29 14 29 15 undefined
+undefined :: Test
+input: :uses T16804a.hs 28  3 28  4
+input: :uses T16804a.hs 28  5 28  7
+T16804a.hs:(28,5)-(28,6)
+T16804a.hs:(28,5)-(28,6)
+input: :uses T16804a.hs 28  8 28 11
+T16804a.hs:(28,8)-(28,10)
+T16804a.hs:(28,14)-(28,16)
+T16804a.hs:(28,8)-(28,10)
+input: :uses T16804a.hs 28 14 28 17
+T16804a.hs:(28,8)-(28,10)
+T16804a.hs:(28,14)-(28,16)
+T16804a.hs:(28,8)-(28,10)
+input: :uses T16804a.hs 29  3 29  4
+input: :uses T16804a.hs 29  5 29  7
+input: :uses T16804a.hs 29  8 29  9
+input: :uses T16804a.hs 29 14 29 15
diff --git a/testsuite/tests/ghci/scripts/T16804a.hs b/testsuite/tests/ghci/scripts/T16804a.hs
new file mode 100644
index 0000000000..7961091b9c
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16804a.hs
@@ -0,0 +1,29 @@
+module T16804a where
+
+import Data.Monoid
+
+data Test = A | B
+  deriving (Show)
+instance Monoid Test where
+  mempty = A
+-- empty for linenumbers in T16804 to be correct
+-- empty for linenumbers in T16804 to be correct
+
+testFunction :: Test -> Test -> Bool
+testFunction A B = True
+testFunction B A = True
+testFunction _ _ = False
+
+testFunction2 :: Bool -> Test
+testFunction2 True = A
+testFunction2 False = B
+
+niceValue :: Int
+niceValue = getSum (Sum 1 <> Sum 2 <> mempty)
+
+niceValue2 :: Test
+niceValue2 = A <> A <> A <> B <> A <> mempty
+
+instance Semigroup Test where
+  A <> val = val
+  B <> _   = B
diff --git a/testsuite/tests/ghci/scripts/T16804b.hs b/testsuite/tests/ghci/scripts/T16804b.hs
new file mode 100644
index 0000000000..5868bd3fe4
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16804b.hs
@@ -0,0 +1,11 @@
+module T16804b where
+
+import T16804a
+
+printStuff :: IO ()
+printStuff = do
+  print (testFunction A A)
+  print (testFunction2 True)
+  print (testFunction2 False)
+  print niceValue
+  print niceValue2
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index e334b7e962..4b838557d2 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -301,3 +301,4 @@ test('T16563', extra_hc_opts("-clear-package-db -global-package-db"), ghci_scrip
 test('T16569', normal, ghci_script, ['T16569.script'])
 test('T16767', normal, ghci_script, ['T16767.script'])
 test('T16575', normal, ghci_script, ['T16575.script'])
+test('T16804', extra_files(['T16804a.hs', 'T16804b.hs']), ghci_script, ['T16804.script'])