Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/000833a7d32590a51c119c58bee9055e38f207b0 >--------------------------------------------------------------- commit 000833a7d32590a51c119c58bee9055e38f207b0 Author: Simon Peyton Jones <[email protected]> Date: Thu Aug 23 16:52:54 2012 +0100 Test Trac #7090 >--------------------------------------------------------------- tests/polykinds/T7090.hs | 26 ++++++++++++++++++++++++++ tests/polykinds/all.T | 2 ++ 2 files changed, 28 insertions(+), 0 deletions(-) diff --git a/tests/polykinds/T7090.hs b/tests/polykinds/T7090.hs new file mode 100644 index 0000000..855633b --- /dev/null +++ b/tests/polykinds/T7090.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE GADTs, ConstraintKinds, TypeFamilies, + DataKinds, ScopedTypeVariables, TypeOperators #-} + +module T7090 where + +import GHC.Exts + +data Dict c where + Dict :: c => Dict c + +data Nat = Zero | Succ Nat + +type family Plus (a :: Nat) (b :: Nat) :: Nat +type instance Plus Zero b = b +type instance Plus (Succ a) b = Succ (Plus a b) + +type One = Succ Zero + +type family (a :: Nat) :==: (b :: Nat) :: Bool + +boolToProp :: (a :==: b) ~ True => Dict (a ~ b) +boolToProp = undefined + +foo :: forall n. (Succ n :==: Plus n One) ~ True => () +foo = case (boolToProp :: Dict (Succ n ~ Plus n One)) of + Dict -> () diff --git a/tests/polykinds/all.T b/tests/polykinds/all.T index 19aad6a..f2d2532 100644 --- a/tests/polykinds/all.T +++ b/tests/polykinds/all.T @@ -62,5 +62,7 @@ test('T7073', normal, compile,['']) test('T7128', normal, compile,['']) test('T7151', normal, compile_fail,['']) test('T7095', normal, compile,['']) +test('T7090', normal, compile,['']) test('T7176', expect_broken(7176), compile,['']) + _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
