[commit: ghc] master: Add a test case for #15962 (8d7496c)

git at git.haskell.org git at git.haskell.org
Fri Nov 30 00:45:49 UTC 2018


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

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

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

commit 8d7496c42f049578187c4e5be08963cb497c2fac
Author: Chaitanya Koparkar <ckoparkar at gmail.com>
Date:   Thu Nov 29 18:47:33 2018 -0500

    Add a test case for #15962
    
    Test Plan: make test TEST=T15962
    
    Reviewers: RyanGlScott, bgamari
    
    Reviewed By: RyanGlScott
    
    Subscribers: rwbarton, carter
    
    GHC Trac Issues: #15962
    
    Differential Revision: https://phabricator.haskell.org/D5393


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

8d7496c42f049578187c4e5be08963cb497c2fac
 testsuite/tests/typecheck/should_fail/T15962.hs    | 36 ++++++++++++++++++++++
 .../tests/typecheck/should_fail/T15962.stderr      | 18 +++++++++++
 testsuite/tests/typecheck/should_fail/all.T        |  1 +
 3 files changed, 55 insertions(+)

diff --git a/testsuite/tests/typecheck/should_fail/T15962.hs b/testsuite/tests/typecheck/should_fail/T15962.hs
new file mode 100644
index 0000000..e42fcde
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T15962.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module T15962 where
+
+import Data.Kind (Type)
+
+type Exp a = a -> Type
+type family Eval (e :: Exp a) :: a
+
+data OpKind = Conjunction
+
+data Dual (k :: OpKind) :: Exp OpKind
+
+data Map :: (a -> Exp b) -> [ a ] -> Exp [ b ]
+
+type instance Eval (Map f (a ': as)) = Eval (f a) ': Eval (Map f as)
+
+data Big :: [ OpKind ] -> Type where
+  Big  :: [ Big ks ] -> Big ('Conjunction ': ks)
+
+dualBig :: Big ks -> Big (Eval (Map Dual ks))
+dualBig = _
+
+instance Semigroup (Big a) where
+  Big xs <> Big ys = Big (xs <> ys)
+
+instance Monoid (Big ('Conjunction ': ks)) where
+  mempty = iDontExist
+
+flatten :: Monoid (Big ks) => Big (k ': k ': ks) -> Big ks
+flatten = undefined
diff --git a/testsuite/tests/typecheck/should_fail/T15962.stderr b/testsuite/tests/typecheck/should_fail/T15962.stderr
new file mode 100644
index 0000000..ffab68c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T15962.stderr
@@ -0,0 +1,18 @@
+T15962.hs:27:11:
+     Found hole: _ :: Big ks -> Big (Eval (Map Dual ks))
+      Where: ‘ks’ is a rigid type variable bound by
+               the type signature for:
+                 dualBig :: forall (ks :: [OpKind]).
+                            Big ks -> Big (Eval (Map Dual ks))
+               at T15962.hs:26:1-45
+     In the expression: _
+      In an equation for ‘dualBig’: dualBig = _
+     Relevant bindings include
+        dualBig :: Big ks -> Big (Eval (Map Dual ks))
+          (bound at T15962.hs:27:1)
+      Valid hole fits include
+        dualBig :: Big ks -> Big (Eval (Map Dual ks))
+          (bound at T15962.hs:27:1)
+
+T15962.hs:33:12:
+    Variable not in scope: iDontExist :: Big ('Conjunction : ks)
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 7dca65b..e033f17 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -489,3 +489,4 @@ test('T15629', normal, compile_fail, [''])
 test('T15767', normal, compile_fail, [''])
 test('T15648', [extra_files(['T15648a.hs'])], multimod_compile_fail, ['T15648', '-v0 -fprint-equality-relations'])
 test('T15796', normal, compile_fail, [''])
+test('T15962', normal, compile_fail, [''])



More information about the ghc-commits mailing list