Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/fed779ee330af005a32d5271006b7e25b74ac829 >--------------------------------------------------------------- commit fed779ee330af005a32d5271006b7e25b74ac829 Author: Simon Peyton Jones <[email protected]> Date: Fri Oct 12 14:08:40 2012 +0100 Test Trac #5913 >--------------------------------------------------------------- tests/typecheck/should_run/T5913.hs | 32 +++++++++++++++++++++++++++++++ tests/typecheck/should_run/T5913.stdout | 4 +++ tests/typecheck/should_run/all.T | 1 + 3 files changed, 37 insertions(+), 0 deletions(-) diff --git a/tests/typecheck/should_run/T5913.hs b/tests/typecheck/should_run/T5913.hs new file mode 100644 index 0000000..f5c94d2 --- /dev/null +++ b/tests/typecheck/should_run/T5913.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE UndecidableInstances #-} +module Main where + +class L0 a where l0 :: a -> a +class L0 a => L1 a where l1 :: a -> a +class L1 a => L2 a where l2 :: a -> a + + +data Worksfine = Worksfine deriving Show +instance L0 Worksfine where l0 = id +instance L1 Worksfine where l1 = l2 +instance {- undecidable -} L1 Worksfine => L2 Worksfine where l2 = l0 + + +data WorksfineToo = WorksfineToo deriving Show +instance L0 WorksfineToo where l0 = id +instance {- undecidable -} L2 WorksfineToo => L1 WorksfineToo where l1 = l2 +instance {- undecidable -} L1 WorksfineToo => L2 WorksfineToo where l2 = id + + +-- l1 LoopsAtRuntime = <loop> +-- l2 LoopsAtRuntime = <loop> +data LoopsAtRuntime = LoopsAtRuntime deriving Show +instance L0 LoopsAtRuntime where l0 = id +instance {- undecidable -} L2 LoopsAtRuntime => L1 LoopsAtRuntime where l1 = l2 +instance {- undecidable -} L1 LoopsAtRuntime => L2 LoopsAtRuntime where l2 = l0 + +main = do + print (l1 WorksfineToo) + print (l2 WorksfineToo) + print (l1 LoopsAtRuntime) + print (l2 LoopsAtRuntime) diff --git a/tests/typecheck/should_run/T5913.stdout b/tests/typecheck/should_run/T5913.stdout new file mode 100644 index 0000000..ef69c8e --- /dev/null +++ b/tests/typecheck/should_run/T5913.stdout @@ -0,0 +1,4 @@ +WorksfineToo +WorksfineToo +LoopsAtRuntime +LoopsAtRuntime diff --git a/tests/typecheck/should_run/all.T b/tests/typecheck/should_run/all.T index ec1fcf6..4c9d7ab 100755 --- a/tests/typecheck/should_run/all.T +++ b/tests/typecheck/should_run/all.T @@ -98,3 +98,4 @@ test('T7023', normal, compile_and_run, ['']) test('T7126', normal, compile_and_run, ['']) test('T6117', expect_broken(6117), compile_and_run, ['']) test('T5751', normal, compile_and_run, ['']) +test('T5913', normal, compile_and_run, ['']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
