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

On branch  : overlapping-tyfams

http://hackage.haskell.org/trac/ghc/changeset/f915be8fefe9b69a9e21e606da924b3f59764196

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

commit f915be8fefe9b69a9e21e606da924b3f59764196
Author: Richard Eisenberg <e...@cis.upenn.edu>
Date:   Mon Dec 3 12:53:44 2012 -0500

    Updated test cases to reflect removal of "type instance where" confluent
    overlap checking.

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

 .../Overlap6.hs => should_compile/Overlap12.hs}    |    8 +++---
 tests/indexed-types/should_compile/all.T           |    3 +-
 .../{should_compile => should_fail}/Overlap11.hs   |    0 
 tests/indexed-types/should_fail/Overlap11.stderr   |    6 ++++
 .../{should_compile => should_fail}/Overlap5.hs    |    0 
 tests/indexed-types/should_fail/Overlap5.stderr    |   29 ++++++++++++++++++++
 tests/indexed-types/should_fail/all.T              |    2 +
 7 files changed, 42 insertions(+), 6 deletions(-)

diff --git a/tests/indexed-types/should_fail/Overlap6.hs 
b/tests/indexed-types/should_compile/Overlap12.hs
similarity index 67%
copy from tests/indexed-types/should_fail/Overlap6.hs
copy to tests/indexed-types/should_compile/Overlap12.hs
index c97992e..414c9d9 100644
--- a/tests/indexed-types/should_fail/Overlap6.hs
+++ b/tests/indexed-types/should_compile/Overlap12.hs
@@ -1,16 +1,16 @@
 {-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}
 
-module Overlap6 where
+module Overlap12 where
 
 type family And (a :: Bool) (b :: Bool) :: Bool
 type instance where
   And False x = False
-  And True x = False -- this is wrong!
+  And True x = x
   And x False = False
   And x True = x
   And x x = x
 
 data Proxy p = P
 
-g :: Proxy x -> Proxy (And x True)
-g x = x
+i :: Proxy (And False x)
+i = (P :: Proxy False)
\ No newline at end of file
diff --git a/tests/indexed-types/should_compile/all.T 
b/tests/indexed-types/should_compile/all.T
index 72ea340..583ab7c 100644
--- a/tests/indexed-types/should_compile/all.T
+++ b/tests/indexed-types/should_compile/all.T
@@ -199,8 +199,7 @@ test('T7082', normal, compile, [''])
 
 test('Overlap1', normal, compile, [''])
 test('Overlap2', normal, compile, [''])
-test('Overlap5', normal, compile, [''])
-test('Overlap11', normal, compile, [''])
+test('Overlap12', normal, compile, [''])
 test('T7156', normal, compile, [''])
 test('T5591a', normal, compile, [''])
 test('T5591b', normal, compile, [''])
diff --git a/tests/indexed-types/should_compile/Overlap11.hs 
b/tests/indexed-types/should_fail/Overlap11.hs
similarity index 100%
rename from tests/indexed-types/should_compile/Overlap11.hs
rename to tests/indexed-types/should_fail/Overlap11.hs
diff --git a/tests/indexed-types/should_fail/Overlap11.stderr 
b/tests/indexed-types/should_fail/Overlap11.stderr
new file mode 100644
index 0000000..0d657da
--- /dev/null
+++ b/tests/indexed-types/should_fail/Overlap11.stderr
@@ -0,0 +1,6 @@
+
+Overlap11.hs:11:6:
+    Couldn't match expected type `F a Int' with actual type `Int'
+    Relevant bindings include g :: F a Int (bound at Overlap11.hs:11:1)
+    In the expression: (5 :: Int)
+    In an equation for `g': g = (5 :: Int)
diff --git a/tests/indexed-types/should_compile/Overlap5.hs 
b/tests/indexed-types/should_fail/Overlap5.hs
similarity index 100%
rename from tests/indexed-types/should_compile/Overlap5.hs
rename to tests/indexed-types/should_fail/Overlap5.hs
diff --git a/tests/indexed-types/should_fail/Overlap5.stderr 
b/tests/indexed-types/should_fail/Overlap5.stderr
new file mode 100644
index 0000000..329d410
--- /dev/null
+++ b/tests/indexed-types/should_fail/Overlap5.stderr
@@ -0,0 +1,29 @@
+
+Overlap5.hs:16:7:
+    Couldn't match type `x' with `And x 'True'
+      `x' is a rigid type variable bound by
+          the type signature for
+            g :: Proxy Bool x -> Proxy Bool (And x 'True)
+          at Overlap5.hs:15:6
+    Expected type: Proxy Bool (And x 'True)
+      Actual type: Proxy Bool x
+    Relevant bindings include
+      g :: Proxy Bool x -> Proxy Bool (And x 'True)
+        (bound at Overlap5.hs:16:1)
+      x :: Proxy Bool x (bound at Overlap5.hs:16:3)
+    In the expression: x
+    In an equation for `g': g x = x
+
+Overlap5.hs:19:7:
+    Couldn't match type `x' with `And x x'
+      `x' is a rigid type variable bound by
+          the type signature for h :: Proxy Bool x -> Proxy Bool (And x x)
+          at Overlap5.hs:18:6
+    Expected type: Proxy Bool (And x x)
+      Actual type: Proxy Bool x
+    Relevant bindings include
+      h :: Proxy Bool x -> Proxy Bool (And x x)
+        (bound at Overlap5.hs:19:1)
+      x :: Proxy Bool x (bound at Overlap5.hs:19:3)
+    In the expression: x
+    In an equation for `h': h x = x
diff --git a/tests/indexed-types/should_fail/all.T 
b/tests/indexed-types/should_fail/all.T
index 4b7f99b..eaf1b19 100644
--- a/tests/indexed-types/should_fail/all.T
+++ b/tests/indexed-types/should_fail/all.T
@@ -80,11 +80,13 @@ test('T7010', normal, compile_fail, [''])
 
 test('Overlap3', normal, compile_fail, [''])
 test('Overlap4', normal, compile_fail, [''])
+test('Overlap5', normal, compile_fail, [''])
 test('Overlap6', normal, compile_fail, [''])
 test('Overlap7', normal, compile_fail, [''])
 test('Overlap8', normal, compile_fail, [''])
 test('Overlap9', normal, compile_fail, [''])
 test('Overlap10', normal, compile_fail, [''])
+test('Overlap11', normal, compile_fail, [''])
 test('T7194', normal, compile_fail, [''])
 test('T7354', normal, compile_fail, [''])
 test('T7354a',



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to