[commit: ghc] wip/tdammers/disable-defer-type-errors-ghci: Test for #14963 workaround (6471606)

git at git.haskell.org git at git.haskell.org
Tue Jun 12 10:41:06 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/tdammers/disable-defer-type-errors-ghci
Link       : http://ghc.haskell.org/trac/ghc/changeset/6471606310d396f012e76071dab8f6fd99169324/ghc

>---------------------------------------------------------------

commit 6471606310d396f012e76071dab8f6fd99169324
Author: Tobias Dammers <tdammers at gmail.com>
Date:   Tue Jun 12 12:38:04 2018 +0200

    Test for #14963 workaround


>---------------------------------------------------------------

6471606310d396f012e76071dab8f6fd99169324
 testsuite/tests/ghci/should_run/Foo.hs        |  4 +++
 testsuite/tests/ghci/should_run/T14963.script |  2 ++
 testsuite/tests/ghci/should_run/T14963.stderr |  4 +++
 testsuite/tests/ghci/should_run/T7253.stderr  | 51 +++++++++++++++++++++++++--
 testsuite/tests/ghci/should_run/T7253.stdout  |  3 --
 testsuite/tests/ghci/should_run/all.T         |  1 +
 6 files changed, 60 insertions(+), 5 deletions(-)

diff --git a/testsuite/tests/ghci/should_run/Foo.hs b/testsuite/tests/ghci/should_run/Foo.hs
new file mode 100644
index 0000000..5fc811d
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/Foo.hs
@@ -0,0 +1,4 @@
+module Foo where
+
+test :: IO Int
+test = return 1
diff --git a/testsuite/tests/ghci/should_run/T14963.script b/testsuite/tests/ghci/should_run/T14963.script
new file mode 100644
index 0000000..785d861
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T14963.script
@@ -0,0 +1,2 @@
+:load Foo.hs
+test
diff --git a/testsuite/tests/ghci/should_run/T14963.stderr b/testsuite/tests/ghci/should_run/T14963.stderr
new file mode 100644
index 0000000..9f8ad02
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T14963.stderr
@@ -0,0 +1,4 @@
+
+<no location info>: error: can't find file: Foo.hs
+
+<interactive>:2:1: error: Variable not in scope: test
diff --git a/testsuite/tests/ghci/should_run/T7253.stderr b/testsuite/tests/ghci/should_run/T7253.stderr
index f7dedda..bd107ba 100644
--- a/testsuite/tests/ghci/should_run/T7253.stderr
+++ b/testsuite/tests/ghci/should_run/T7253.stderr
@@ -1,8 +1,55 @@
 
+<interactive>:8:7: error:
+    • Ambiguous type variable ‘t0’ arising from a use of ‘sum’
+      prevents the constraint ‘(Foldable t0)’ from being solved.
+      Relevant bindings include
+        add :: t0 Integer -> Integer (bound at <interactive>:8:1)
+      Probable fix: use a type annotation to specify what ‘t0’ should be.
+      These potential instances exist:
+        instance Foldable (Either a) -- Defined in ‘Data.Foldable’
+        instance Foldable Maybe -- Defined in ‘Data.Foldable’
+        instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
+        ...plus one other
+        ...plus 24 instances involving out-of-scope types
+        (use -fprint-potential-instances to see them all)
+    • In the expression: sum
+      In an equation for ‘add’: add = sum
+
+<interactive>:9:5: error:
+    • Couldn't match expected type ‘Int’ with actual type ‘[Integer]’
+    • In the first argument of ‘add’, namely ‘[1, 2, 3]’
+      In the expression: add [1, 2, 3]
+      In an equation for ‘it’: it = add [1, 2, 3]
+
 <interactive>:19:1: warning: [-Wunrecognised-pragmas (in -Wdefault)]
     Unrecognised pragma
 
+<interactive>:27:1: error:
+    Illegal standalone deriving declaration
+      Use StandaloneDeriving to enable this extension
+
+<interactive>:31:1: error:
+    • No instance for (Show Foo) arising from a use of ‘show’
+    • In the expression: show foo
+      In an equation for ‘it’: it = show foo
+
+<interactive>:44:3: error:
+    Unexpected default signature:
+      default content :: Show a => a -> String
+    Use DefaultSignatures to enable default signatures
+
+<interactive>:49:10: error:
+    Not in scope: type constructor or class ‘HasString’
+
+<interactive>:54:1: error:
+    Variable not in scope: upcase :: Foo -> t
+
 <interactive>:62:1: error:
-    • Role mismatch on variable b:
-        Annotation says phantom but role representational is required
+    • Illegal role annotation for T1;
+      did you intend to use RoleAnnotations?
     • while checking a role annotation for ‘T1’
+
+<interactive>:67:1: error:
+    • Illegal role annotation for T2;
+      did you intend to use RoleAnnotations?
+    • while checking a role annotation for ‘T2’
diff --git a/testsuite/tests/ghci/should_run/T7253.stdout b/testsuite/tests/ghci/should_run/T7253.stdout
index 2d29a0f..fd3c81a 100644
--- a/testsuite/tests/ghci/should_run/T7253.stdout
+++ b/testsuite/tests/ghci/should_run/T7253.stdout
@@ -1,5 +1,2 @@
 5
-6
 5
-"Foo \"Some foo\""
-Foo "SOME FOO"
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index c64b0e7..c4b00ba 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -30,3 +30,4 @@ test('T12549',     just_ghci, ghci_script, ['T12549.script'])
 test('BinaryArray', normal, compile_and_run, [''])
 test('T14125a',    just_ghci, ghci_script, ['T14125a.script'])
 test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script'])
+test('T14963',     just_ghci, ghci_script, ['T14963.script', '-fdefer-type-errors'])



More information about the ghc-commits mailing list