[commit: ghc] master: Test Trac #15648 (a3476aa)

git at git.haskell.org git at git.haskell.org
Thu Oct 25 08:10:20 UTC 2018


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a3476aa265a4448df9c8d3333d6829a898108af6/ghc

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

commit a3476aa265a4448df9c8d3333d6829a898108af6
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Oct 24 16:51:32 2018 +0100

    Test Trac #15648


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

a3476aa265a4448df9c8d3333d6829a898108af6
 testsuite/tests/typecheck/should_fail/T15648.hs    | 30 ++++++++++++++++++++++
 .../tests/typecheck/should_fail/T15648.stderr      | 23 +++++++++++++++++
 testsuite/tests/typecheck/should_fail/T15648a.hs   |  7 +++++
 testsuite/tests/typecheck/should_fail/all.T        |  1 +
 4 files changed, 61 insertions(+)

diff --git a/testsuite/tests/typecheck/should_fail/T15648.hs b/testsuite/tests/typecheck/should_fail/T15648.hs
new file mode 100644
index 0000000..a566a1b
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T15648.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+module T15648 where
+
+import Data.Kind (Type)
+import Data.Type.Equality (type (~~))
+import T15648a (ueqT)
+
+data LegitEquality :: Type -> Type -> Type where
+  Legit :: LegitEquality a a
+
+data JankyEquality :: Type -> Type -> Type where
+  Jank :: $ueqT a b -> JankyEquality a b
+
+unJank :: JankyEquality a b -> $ueqT a b
+unJank (Jank x) = x
+
+legitToJank :: LegitEquality a b -> JankyEquality a b
+legitToJank Legit = Jank
+
+mkLegit :: a ~~ b => LegitEquality a b
+mkLegit = Legit
+
+ueqSym :: forall (a :: Type) (b :: Type).
+          $ueqT a b -> $ueqT b a
+ueqSym = unJank $ legitToJank $ mkLegit @b @a
diff --git a/testsuite/tests/typecheck/should_fail/T15648.stderr b/testsuite/tests/typecheck/should_fail/T15648.stderr
new file mode 100644
index 0000000..192d8d1
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T15648.stderr
@@ -0,0 +1,23 @@
+
+T15648.hs:23:21: error:
+    • Couldn't match type ‘(a0 GHC.Prim.~# b0) -> JankyEquality a0 b0’
+                     with ‘JankyEquality a a’
+      Expected type: JankyEquality a b
+        Actual type: (a0 GHC.Prim.~# b0) -> JankyEquality a0 b0
+    • Probable cause: ‘Jank’ is applied to too few arguments
+      In the expression: Jank
+      In an equation for ‘legitToJank’: legitToJank Legit = Jank
+    • Relevant bindings include
+        legitToJank :: LegitEquality a b -> JankyEquality a b
+          (bound at T15648.hs:23:1)
+
+T15648.hs:30:10: error:
+    • Couldn't match expected type ‘(a GHC.Prim.~# b)
+                                    -> b GHC.Prim.~# a’
+                  with actual type ‘b GHC.Prim.~# a’
+    • In the expression: unJank $ legitToJank $ mkLegit @b @a
+      In an equation for ‘ueqSym’:
+          ueqSym = unJank $ legitToJank $ mkLegit @b @a
+    • Relevant bindings include
+        ueqSym :: (a GHC.Prim.~# b) -> b GHC.Prim.~# a
+          (bound at T15648.hs:30:1)
diff --git a/testsuite/tests/typecheck/should_fail/T15648a.hs b/testsuite/tests/typecheck/should_fail/T15648a.hs
new file mode 100644
index 0000000..73a05bb
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T15648a.hs
@@ -0,0 +1,7 @@
+module T15648a where
+
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Syntax
+
+ueqT :: Q Type
+ueqT = conT $ mkNameG_tc "ghc-prim" "GHC.Prim" "~#"
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 35c925e..f80f5cd 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -485,3 +485,4 @@ test('T15552', normal, compile, [''])
 test('T15552a', normal, compile_fail, [''])
 test('T15629', normal, compile_fail, [''])
 test('T15767', normal, compile_fail, [''])
+test('T15648', [extra_files(['T15648a.hs'])], multimod_compile_fail, ['T15648', '-v0 -fprint-equality-relations'])



More information about the ghc-commits mailing list