A second test for Trac #12055

This one omits the extension, thereby making GHC 8.0 produce
"GHC internal error".

3 files changed, 53 insertions, 0 deletions

diff --git a/testsuite/tests/polykinds/T12055a.hs b/testsuite/tests/polykinds/T12055a.hs
new file mode 100644
index 0000000000..dab523861b
--- /dev/null
+++ b/testsuite/tests/polykinds/T12055a.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeInType #-}
+
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, FunctionalDependencies #-}
+
+-- The code from the ticket lacked necessary extension FlexibleContexts
+-- which crashed the compiler with "GHC internal error"
+-- This test case reproduces that scenario
+{- # LANGUAGE FlexibleContexts #-}
+
+module T12055a where
+
+import GHC.Base ( Constraint, Type )
+import GHC.Exts ( type (~~) )
+
+type Cat k = k -> k -> Type
+
+class Category (p :: Cat k) where
+    type Ob p :: k -> Constraint
+
+class (Category (Dom f), Category (Cod f)) => Functor (f :: j -> k) where
+    type Dom f :: Cat j
+    type Cod f :: Cat k
+    functor :: forall a b.
+               Iso Constraint (:-) (:-)
+               (Ob (Dom f) a)     (Ob (Dom f) b)
+               (Ob (Cod f) (f a)) (Ob (Cod f) (f b))
+
+class (Functor f , Dom f ~ p, Cod f ~ q) =>
+    Fun (p :: Cat j) (q :: Cat k) (f :: j -> k) | f -> p q
+instance (Functor f , Dom f ~ p, Cod f ~ q) =>
+    Fun (p :: Cat j) (q :: Cat k) (f :: j -> k)
+
+data Nat (p :: Cat j) (q :: Cat k) (f :: j -> k) (g :: j -> k)
+
+type Iso k (c :: Cat k) (d :: Cat k) s t a b =
+    forall p. (Cod p ~~ Nat d (->)) => p a b -> p s t
+
+data (p :: Constraint) :- (q :: Constraint)
diff --git a/testsuite/tests/polykinds/T12055a.stderr b/testsuite/tests/polykinds/T12055a.stderr
new file mode 100644
index 0000000000..fb76dd4989
--- /dev/null
+++ b/testsuite/tests/polykinds/T12055a.stderr
@@ -0,0 +1,7 @@
+
+T12055a.hs:27:1: error:
+    • Non type-variable argument in the constraint: Category (Dom f)
+      (Use FlexibleContexts to permit this)
+    • In the context: (Category (Dom f), Category (Cod f))
+      While checking the super-classes of class ‘Functor’
+      In the class declaration for ‘Functor’
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index c731441679..bcc8dc4f81 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -149,3 +149,4 @@ test('KindVType', normal, compile_fail, [''])
 test('T11821', normal, compile, [''])
 test('T11640', normal, compile, [''])
 test('T12055', normal, compile, [''])
+test('T12055a', normal, compile_fail, [''])