[commit: ghc] master: Test Trac #9939 (c790fe8)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c790fe87be648f420c63099934852013a4e8a8f7/ghc

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

commit c790fe87be648f420c63099934852013a4e8a8f7
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Jan 6 15:28:16 2015 +0000

    Test Trac #9939


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

c790fe87be648f420c63099934852013a4e8a8f7
 compiler/typecheck/TcSimplify.hs                   | 10 ++++++++++
 testsuite/tests/typecheck/should_compile/T9939.hs  | 23 ++++++++++++++++++++++
 .../should_compile/T9939.stderr}                   |  0
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 4 files changed, 34 insertions(+)

diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 761a7a5..b226fde 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -1104,6 +1104,16 @@ works:
   so that we can discard implication constraints that we don't need.
   So ics_dead consists only of the *reportable* redundant givens.
 
+----- Shortcomings
+
+Consider (see Trac #9939)
+    f2 :: (Eq a, Ord a) => a -> a -> Bool
+    -- Ord a redundant, but Eq a is reported
+    f2 x y = (x == y)
+
+We report (Eq a) as redundant, whereas actually (Ord a) is.  But it's
+really not easy to detect that!
+
 
 Note [Cutting off simpl_loop]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/typecheck/should_compile/T9939.hs b/testsuite/tests/typecheck/should_compile/T9939.hs
new file mode 100644
index 0000000..4ae370b
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9939.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE GADTs #-}
+
+module T9939 where
+
+f1 :: (Eq a, Ord a) => a -> a -> Bool
+-- Eq a redundant
+f1 x y = (x == y) && (x > y)
+
+f2 :: (Eq a, Ord a) => a -> a -> Bool
+-- Ord a redundant, but Eq a is reported
+f2 x y = (x == y)
+
+f3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool
+-- Eq b redundant
+f3 x y = x==y
+
+data Equal a b where
+  EQUAL :: Equal a a
+
+f4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool
+-- Eq b redundant
+f4 x y EQUAL = y==y
+
diff --git a/testsuite/tests/deSugar/should_run/T5472.stdout b/testsuite/tests/typecheck/should_compile/T9939.stderr
similarity index 100%
copy from testsuite/tests/deSugar/should_run/T5472.stdout
copy to testsuite/tests/typecheck/should_compile/T9939.stderr
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index d1b3796..0860a35 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -437,4 +437,5 @@ test('T9497c', normal, compile, ['-fdefer-type-errors -fno-warn-typed-holes'])
 test('T7643', normal, compile, [''])
 test('T9834', normal, compile, [''])
 test('T9892', normal, compile, [''])
+test('T9939', normal, compile, [''])