[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