Add tests for superclass equalities
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 22 Jun 2011 16:51:14 +0000 (17:51 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 22 Jun 2011 16:51:14 +0000 (17:51 +0100)
testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.stderr [deleted file]
testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.stderr [deleted file]
testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.stderr [deleted file]
testsuite/tests/ghc-regress/indexed-types/should_compile/HO.stderr [deleted file]
testsuite/tests/ghc-regress/indexed-types/should_compile/T2102.hs [new file with mode: 0644]
testsuite/tests/ghc-regress/indexed-types/should_compile/T2715.hs [new file with mode: 0644]
testsuite/tests/ghc-regress/indexed-types/should_compile/T4338.hs [new file with mode: 0644]
testsuite/tests/ghc-regress/indexed-types/should_compile/all.T
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail106.stderr

diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.stderr
deleted file mode 100644 (file)
index f4d4a93..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-
-ClassEqContext.hs:5:1:
-    Alas, GHC 7.0 still cannot handle equality superclasses: a ~ b
-    In the context: (a ~ b)
-    While checking the super-classes of class `C'
-    In the class declaration for `C'
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.stderr
deleted file mode 100644 (file)
index 3ab0a35..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-
-ClassEqContext2.hs:6:1:
-    Alas, GHC 7.0 still cannot handle equality superclasses: a ~ b
-    In the context: (a ~ b, Show a)
-    While checking the super-classes of class `C'
-    In the class declaration for `C'
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.stderr
deleted file mode 100644 (file)
index 56b0aab..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-
-ClassEqContext3.hs:6:1:
-    Alas, GHC 7.0 still cannot handle equality superclasses: a ~ b
-    In the context: (a ~ b)
-    While checking the super-classes of class `C'
-    In the class declaration for `C'
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/HO.stderr b/testsuite/tests/ghc-regress/indexed-types/should_compile/HO.stderr
deleted file mode 100644 (file)
index cb14fb7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-
-HO.hs:14:1:
-    Alas, GHC 7.0 still cannot handle equality superclasses:
-      SMMonad (SMRef m) ~ m
-    In the context: (SMMonad (SMRef m) ~ m)
-    While checking the super-classes of class `SM'
-    In the class declaration for `SM'
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2102.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2102.hs
new file mode 100644 (file)
index 0000000..6283b18
--- /dev/null
@@ -0,0 +1,19 @@
+{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}
+
+module T2102 where
+
+type family Cat ts0 ts
+type instance Cat ()      ts' = ts'
+type instance Cat (s, ts) ts' = (s, Cat ts ts')
+
+class (Cat ts () ~ ts) => Valid ts
+instance Valid () -- compiles OK
+instance Valid ts => Valid (s, ts) -- fails to compile
+
+-- need to prove Cat (s, ts) () ~ (s, Cat ts ())
+-- for the superclass of class Valid.
+-- (1) From Valid ts: Cat ts () ~ ts
+-- (2) Therefore:     (s, Cat ts ()) ~ (s, ts)
+
+coerce :: forall f ts. Valid ts => f (Cat ts ()) -> f ts
+coerce x = x
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T2715.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T2715.hs
new file mode 100644 (file)
index 0000000..0fae15e
--- /dev/null
@@ -0,0 +1,32 @@
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module T2715 where
+
+data Interval v where
+   Intv :: (Ord v, Enum v) => (v,v) -> Interval v
+
+type family Domain (d :: * -> *) :: * -> *
+type instance Domain Interval = Interval 
+
+type family Value (d :: * -> *) :: *
+
+
+class IDomain d where
+   empty   :: (Ord (Value d), Enum (Value d)) => (Domain d) (Value d)
+
+class (IDomain d1) -- (IDomain d1, IDomain d2, Value d1 ~ Value d2) 
+   => IIDomain (d1 :: * -> *) (d2 :: * -> * ) where
+   equals  :: Domain d1 (Value d1) -> Domain d2 (Value d2) -> Bool
+
+
+instance Ord (Value Interval) 
+      => IDomain Interval where
+   empty                   = Intv (toEnum 1, toEnum 0)
+
+instance Ord (Value Interval) 
+      => IIDomain Interval Interval where
+   equals  (Intv ix) (Intv iy) = ix == iy
diff --git a/testsuite/tests/ghc-regress/indexed-types/should_compile/T4338.hs b/testsuite/tests/ghc-regress/indexed-types/should_compile/T4338.hs
new file mode 100644 (file)
index 0000000..6fa2ae8
--- /dev/null
@@ -0,0 +1,23 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
+
+module Main where
+
+class (There a ~ b, BackAgain b ~ a) => Foo a b where
+     type There a
+     type BackAgain b
+     there :: a -> b
+     back :: b -> a
+     tickle :: b -> b
+
+instance Foo Char Int where
+     type There Char = Int
+     type BackAgain Int = Char
+     there = fromEnum
+     back = toEnum
+     tickle = (+1)
+
+test :: (Foo a b) => a -> a
+test = back . tickle . there
+
+main :: IO ()
+main = print $ test 'F'
index f334ce7..a5b6130 100644 (file)
@@ -93,10 +93,6 @@ test('ColInference4', normal, compile, [''])
 test('ColInference5', normal, compile, [''])
 test('ColInference6', normal, compile, [''])
 
-test('ClassEqContext', normal, compile_fail, [''])
-test('ClassEqContext2', normal, compile_fail, [''])
-test('ClassEqContext3', normal, compile_fail, [''])
-
 test('Col', normal, compile, [''])
 test('Col2', normal, compile, [''])
 
@@ -109,8 +105,6 @@ test('InstEqContext3', expect_fail, compile, [''])
 
 test('InstContextNorm', normal, compile, [''])
 
-test('HO', normal, compile_fail, [''])
-
 test('GivenCheck', normal, compile, [''])
 test('GivenCheckSwap', normal, compile, [''])
 test('GivenCheckDecomp', normal, compile, [''])
@@ -120,7 +114,7 @@ test('GivenCheckTop', normal, compile, [''])
 test('Gentle', normal, compile, [''])
 
 test('T1981', normal, compile, [''])
-test('T2238', expect_fail, compile, [''])
+test('T2238', normal, compile, [''])
 test('OversatDecomp', normal, compile, [''])
 
 test('T2219', normal, compile, [''])
@@ -178,3 +172,14 @@ test('T4981-V3', normal, compile, [''])
 test('T5002', normal, compile, [''])
 test('PushedInAsGivens', normal, compile, [''])
 test('SlowComp', reqlib('mtl'), compile, ['-fcontext-stack=300'])
+
+# Superclass equalities
+test('T4338', normal, compile, [''])
+test('T2715', normal, compile, [''])
+test('T2102', normal, compile, [''])
+test('ClassEqContext', normal, compile, [''])
+test('ClassEqContext2', normal, compile, [''])
+test('ClassEqContext3', normal, compile, [''])
+test('HO', normal, compile, [''])
+
+
index 3000479..e9de772 100644 (file)
@@ -4,3 +4,9 @@ tcfail106.hs:11:10:
       arising from the superclasses of an instance declaration
     Possible fix: add an instance declaration for (S Int)
     In the instance declaration for `C Int'
+
+tcfail106.hs:14:10:
+    No instance for (S Int)
+      arising from the superclasses of an instance declaration
+    Possible fix: add an instance declaration for (S Int)
+    In the instance declaration for `D Int'