Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/83872a69317407061f57f43743f4e18ba57df003 >--------------------------------------------------------------- commit 83872a69317407061f57f43743f4e18ba57df003 Author: Simon Peyton Jones <[email protected]> Date: Wed Jun 22 17:51:14 2011 +0100 Add tests for superclass equalities >--------------------------------------------------------------- .../should_compile/ClassEqContext.stderr | 6 ---- .../should_compile/ClassEqContext2.stderr | 6 ---- .../should_compile/ClassEqContext3.stderr | 6 ---- .../indexed-types/should_compile/HO.stderr | 7 ---- .../indexed-types/should_compile/T2102.hs | 19 ++++++++++++ .../indexed-types/should_compile/T2715.hs | 32 ++++++++++++++++++++ .../indexed-types/should_compile/T4338.hs | 23 ++++++++++++++ .../ghc-regress/indexed-types/should_compile/all.T | 19 +++++++---- .../typecheck/should_fail/tcfail106.stderr | 6 ++++ 9 files changed, 92 insertions(+), 32 deletions(-) diff --git a/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.stderr b/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.stderr deleted file mode 100644 index f4d4a93..0000000 --- a/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.stderr +++ /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/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.stderr b/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.stderr deleted file mode 100644 index 3ab0a35..0000000 --- a/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.stderr +++ /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/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.stderr b/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.stderr deleted file mode 100644 index 56b0aab..0000000 --- a/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.stderr +++ /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/tests/ghc-regress/indexed-types/should_compile/HO.stderr b/tests/ghc-regress/indexed-types/should_compile/HO.stderr deleted file mode 100644 index cb14fb7..0000000 --- a/tests/ghc-regress/indexed-types/should_compile/HO.stderr +++ /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/tests/ghc-regress/indexed-types/should_compile/T2102.hs b/tests/ghc-regress/indexed-types/should_compile/T2102.hs new file mode 100644 index 0000000..6283b18 --- /dev/null +++ b/tests/ghc-regress/indexed-types/should_compile/T2102.hs @@ -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/tests/ghc-regress/indexed-types/should_compile/T2715.hs b/tests/ghc-regress/indexed-types/should_compile/T2715.hs new file mode 100644 index 0000000..0fae15e --- /dev/null +++ b/tests/ghc-regress/indexed-types/should_compile/T2715.hs @@ -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/tests/ghc-regress/indexed-types/should_compile/T4338.hs b/tests/ghc-regress/indexed-types/should_compile/T4338.hs new file mode 100644 index 0000000..6fa2ae8 --- /dev/null +++ b/tests/ghc-regress/indexed-types/should_compile/T4338.hs @@ -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' diff --git a/tests/ghc-regress/indexed-types/should_compile/all.T b/tests/ghc-regress/indexed-types/should_compile/all.T index f334ce7..a5b6130 100644 --- a/tests/ghc-regress/indexed-types/should_compile/all.T +++ b/tests/ghc-regress/indexed-types/should_compile/all.T @@ -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, ['']) + + diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail106.stderr b/tests/ghc-regress/typecheck/should_fail/tcfail106.stderr index 3000479..e9de772 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail106.stderr +++ b/tests/ghc-regress/typecheck/should_fail/tcfail106.stderr @@ -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' _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
