summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2012-05-16 11:15:02 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2012-05-16 11:15:02 +0100
commitaccd944a69fb669596a1384ac717336b46529e00 (patch)
treee4cd87b045c38ad233b37aaa763302763ed52138
parentd93dc415916f23088c70eb6613d685911fb14e23 (diff)
downloadhaskell-accd944a69fb669596a1384ac717336b46529e00.tar.gz
Test Trac #6015 and #6068
-rw-r--r--testsuite/tests/polykinds/T6015a.hs14
-rw-r--r--testsuite/tests/polykinds/T6068.hs27
-rw-r--r--testsuite/tests/polykinds/T6068.script2
-rw-r--r--testsuite/tests/polykinds/T6068.stdout1
-rw-r--r--testsuite/tests/polykinds/all.T2
5 files changed, 46 insertions, 0 deletions
diff --git a/testsuite/tests/polykinds/T6015a.hs b/testsuite/tests/polykinds/T6015a.hs
new file mode 100644
index 0000000000..f42019cc52
--- /dev/null
+++ b/testsuite/tests/polykinds/T6015a.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE PolyKinds, KindSignatures, FunctionalDependencies, FlexibleInstances,
+ UndecidableInstances, TypeOperators, DataKinds, FlexibleContexts #-}
+
+module T6015a where
+
+import Prelude hiding ((++))
+
+data T a = T
+
+class ((a :: [k]) ++ (b :: [k])) (c :: [k]) | a b -> c
+instance ('[] ++ b) b
+instance (a ++ b) c => ((x ': a) ++ b) (x ': c)
+
+test = T :: ('[True] ++ '[]) l => T l
diff --git a/testsuite/tests/polykinds/T6068.hs b/testsuite/tests/polykinds/T6068.hs
new file mode 100644
index 0000000000..f9b7dc2c9b
--- /dev/null
+++ b/testsuite/tests/polykinds/T6068.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, GADTs, MultiParamTypeClasses,
+ FunctionalDependencies, FlexibleInstances, UndecidableInstances, ExistentialQuantification #-}
+
+module T6068 where
+
+import Prelude hiding (Maybe, Nothing)
+
+data Maybe :: * -> * where
+ Nothing :: Maybe a
+
+data family Sing (a :: k)
+
+data instance Sing (a :: Maybe k) where
+ SNothing :: Sing Nothing
+
+data KProxy (a :: *) = KProxy
+data Existential (p :: KProxy k) =
+ forall (a :: k). Exists (Sing a)
+
+class HasSingleton a (kp :: KProxy k) | a -> kp where
+ exists :: a -> Existential kp
+
+instance forall a (mp :: KProxy (Maybe ak)). HasSingleton (Maybe a) mp where
+ exists Nothing = Exists SNothing
+
+-- instance forall (a ::*) (mp :: KProxy (Maybe ak)). HasSingleton (Maybe ak) (Maybe a) mp where
+-- exists Nothing = Exists SNothing
diff --git a/testsuite/tests/polykinds/T6068.script b/testsuite/tests/polykinds/T6068.script
new file mode 100644
index 0000000000..6b34183986
--- /dev/null
+++ b/testsuite/tests/polykinds/T6068.script
@@ -0,0 +1,2 @@
+:l T6068
+:t exists Nothing
diff --git a/testsuite/tests/polykinds/T6068.stdout b/testsuite/tests/polykinds/T6068.stdout
new file mode 100644
index 0000000000..32952bbc54
--- /dev/null
+++ b/testsuite/tests/polykinds/T6068.stdout
@@ -0,0 +1 @@
+exists Nothing :: Existential (Maybe *) kp
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index cb017f12fc..d2459d0810 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -46,3 +46,5 @@ test('T6044', normal, compile, [''])
test('T6054', normal, run_command, ['$MAKE -s --no-print-directory T6054'])
test('T6081', normal, compile, [''])
test('T6015', normal, compile, [''])
+test('T6015a', normal, compile, [''])
+test('T6068', normal, ghci_script, ['T6068.script'])