From 85da17e5518cfc88c23964e6ffcad07886da5b59 Mon Sep 17 00:00:00 2001
From: Eric Wolf <ericwolf42@gmail.com>
Date: Sat, 6 Jul 2019 17:36:24 +0200
Subject: [PATCH] Add testcase T16804 for #16804
slightly larger testcase for :type-at and :uses
so we can see changes, if #16804 is done.
---
testsuite/tests/ghci/scripts/T16804.script | 150 ++++++++++++++++
testsuite/tests/ghci/scripts/T16804.stderr | 30 ++++
testsuite/tests/ghci/scripts/T16804.stdout | 194 +++++++++++++++++++++
testsuite/tests/ghci/scripts/T16804a.hs | 29 +++
testsuite/tests/ghci/scripts/T16804b.hs | 11 ++
testsuite/tests/ghci/scripts/all.T | 1 +
6 files changed, 415 insertions(+)
create mode 100644 testsuite/tests/ghci/scripts/T16804.script
create mode 100644 testsuite/tests/ghci/scripts/T16804.stderr
create mode 100644 testsuite/tests/ghci/scripts/T16804.stdout
create mode 100644 testsuite/tests/ghci/scripts/T16804a.hs
create mode 100644 testsuite/tests/ghci/scripts/T16804b.hs
diff --git a/testsuite/tests/ghci/scripts/T16804.script b/testsuite/tests/ghci/scripts/T16804.script
new file mode 100644
index 000000000000..ec30ec1537ae
--- /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 000000000000..3d439200cb1f
--- /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 000000000000..ddae235fc02f
--- /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 000000000000..7961091b9c6c
--- /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 000000000000..5868bd3fe4d7
--- /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 e334b7e9628b..4b838557d228 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'])
--
GitLab