[commit: testsuite] master: Add a test for #6117 (66f65ac)

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/66f65ac9da2c0626a40d67515be07db9febb3628

>---------------------------------------------------------------

commit 66f65ac9da2c0626a40d67515be07db9febb3628
Author: Ian Lynagh <[email protected]>
Date:   Thu Oct 11 20:57:10 2012 +0100

    Add a test for #6117

>---------------------------------------------------------------

 tests/typecheck/should_run/T6117.hs |   53 +++++++++++++++++++++++++++++++++++
 tests/typecheck/should_run/all.T    |    1 +
 2 files changed, 54 insertions(+), 0 deletions(-)

diff --git a/tests/typecheck/should_run/T6117.hs b/tests/typecheck/should_run/T6117.hs
new file mode 100644
index 0000000..2fe9f29
--- /dev/null
+++ b/tests/typecheck/should_run/T6117.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+{-
+[Summary of the program] Ring is defined as a subclass of Semigroup,
+inheriting multiplication.  Additive is a wrapper that extracts the additive
+structure of Ring and reifies it as Semigroup.  For simplicity, the code omits
+ring operations (+ and *) and defines only the additive and multiplicative
+identities.
+
+[The bug] If there is a cyclic class hierarchy like
+
+    class B a => Semigroup a                  where ...
+    class Semigroup (Additive a) => Ring a    where ...
+    instance Ring a => Semigroup (Additive a) where ...
+
+then uses of B's methods on (Additive a) in the method implementations of the
+third declaration "instance Ring a => Semigroup (Additive a)" will:
+
+    1. be accepted by the compiler even in cases where B (Additive a) is not
+       derivable.
+    2. result in <<loop>>.
+ -}
+
+class B a where
+    b :: a
+class B a => Semigroup a where
+    unit :: a
+class (Semigroup a, Semigroup (Additive a)) => Ring a where
+    zero :: a
+newtype Additive a = Additive a
+
+-- The source compiles whether with or without this instance declaration in GHC
+-- 7.2.1 - 7.4.1 and produces <<loop>>.
+--
+-- GHC 7.0.4 rejects this source without this declaration and produces
+-- terminating code with the declaration.
+instance B a => B (Additive a) where
+   b = Additive b
+
+instance Ring a => Semigroup (Additive a) where
+    unit = b -- Use a method of type (B a => ...) with a instantiated as
+             -- (Additive a).  This causes <<loop>>.
+
+
+-- Now try to instantiate Ring and evaluate `unit'.
+instance B Int where
+    b = 1234567890
+instance Semigroup Int where
+    unit = 1
+instance Ring Int where
+    zero = 0
+main = case (unit :: Additive Int) of -- Force the additive identity of Int.
+         Additive x -> print x
diff --git a/tests/typecheck/should_run/all.T b/tests/typecheck/should_run/all.T
index 2f236d8..709bb32 100755
--- a/tests/typecheck/should_run/all.T
+++ b/tests/typecheck/should_run/all.T
@@ -96,3 +96,4 @@ test('T5573a', compose(omit_ways(['ghci']),only_compiler_types(['ghc'])), compil
 test('T5573b', compose(omit_ways(['ghci']),only_compiler_types(['ghc'])), compile_and_run, [''])
 test('T7023', normal, compile_and_run, [''])
 test('T7126', normal, compile_and_run, [''])
+test('T6117', expect_broken(6117), compile_and_run, [''])