Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/debecdd231b28aa5e73967e01b34408b8c95b7a3 >--------------------------------------------------------------- commit debecdd231b28aa5e73967e01b34408b8c95b7a3 Author: Simon Peyton Jones <[email protected]> Date: Wed Jun 22 11:21:29 2011 +0100 Test Trac #5051 >--------------------------------------------------------------- .../ghc-regress/typecheck/should_compile/T5051.hs | 33 ++++++++++++++++++++ tests/ghc-regress/typecheck/should_compile/all.T | 3 +- 2 files changed, 35 insertions(+), 1 deletions(-) diff --git a/tests/ghc-regress/typecheck/should_compile/T5051.hs b/tests/ghc-regress/typecheck/should_compile/T5051.hs new file mode 100644 index 0000000..e98c074 --- /dev/null +++ b/tests/ghc-regress/typecheck/should_compile/T5051.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE FlexibleInstances, OverlappingInstances #-} + +-- A very delicate interaction of overlapping instances + +module T5051 where + +data T = T deriving( Eq, Ord ) +instance Eq [T] + +foo :: Ord a => [a] -> Bool +foo x = x >= x + +-- Bizarrely, the defn of 'foo' failed in GHC 7.0.3 with +-- T5051.hs:14:10: +-- Overlapping instances for Eq [a] +-- arising from a use of `>' +-- Matching instances: +-- instance Eq a => Eq [a] -- Defined in GHC.Classes +-- instance [overlap ok] Eq [T] -- Defined at T5051.hs:9:10-15 +-- (The choice depends on the instantiation of `a' +-- To pick the first instance above, use -XIncoherentInstances +-- when compiling the other instance declarations) +-- In the expression: x > x +-- +-- Reason: the dfun for Ord [a] (in the Prelude) had a "silent" +-- superclass parameter, thus +-- $dfOrdList :: forall a. (Eq [a], Ord a) => Ord [a] +-- Using the dfun means we need Eq [a], and that gives rise to the +-- overlap error. +-- +-- This is terribly confusing: the use of (>=) means we need Ord [a], +-- and if we have Ord a (which we do) we should be done. +-- A very good reason for not having silent parameters! diff --git a/tests/ghc-regress/typecheck/should_compile/all.T b/tests/ghc-regress/typecheck/should_compile/all.T index e7fed26..9ed138d 100644 --- a/tests/ghc-regress/typecheck/should_compile/all.T +++ b/tests/ghc-regress/typecheck/should_compile/all.T @@ -343,4 +343,5 @@ test('tc249', normal, compile, ['']) test('GivenOverlapping', normal, compile, ['']) test('SilentParametersOverlapping', normal, compile, ['']) -test('GivenTypeSynonym', normal, compile, ['']) \ No newline at end of file +test('GivenTypeSynonym', normal, compile, ['']) +test('T5051', normal, compile, ['']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
