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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/2bc8e7ab5f81ac82065802f45dd5781784beb25c

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

commit 2bc8e7ab5f81ac82065802f45dd5781784beb25c
Author: Simon Peyton Jones <[email protected]>
Date:   Sat Jul 14 13:48:45 2012 +0100

    Test Trac #5978 and #7010

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

 tests/indexed-types/should_fail/T7010.hs     |   44 ++++++++++++++++++++++++++
 tests/indexed-types/should_fail/T7010.stderr |    8 +++++
 tests/indexed-types/should_fail/all.T        |    4 +-
 tests/typecheck/should_fail/T5978.hs         |   26 +++++++++++++++
 tests/typecheck/should_fail/T5978.stderr     |   10 ++++++
 tests/typecheck/should_fail/all.T            |    3 +-
 6 files changed, 92 insertions(+), 3 deletions(-)

diff --git a/tests/indexed-types/should_fail/T7010.hs 
b/tests/indexed-types/should_fail/T7010.hs
new file mode 100644
index 0000000..cb32014
--- /dev/null
+++ b/tests/indexed-types/should_fail/T7010.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T7010 where
+
+type Vector = Serial Float
+data Serial v = Serial
+
+class MakeValueTuple a where
+   type ValueTuple a :: *
+
+instance MakeValueTuple Float where
+   type ValueTuple Float = IO Float
+
+instance (MakeValueTuple v) => MakeValueTuple (Serial v) where
+   type ValueTuple (Serial v) = Serial (ValueTuple v)
+
+
+stereoFromMono :: (v, v)
+stereoFromMono = undefined
+
+processIO ::
+   (MakeValueTuple a) =>
+   (ValueTuple a, ValueTuple a) ->
+   (a, a)
+processIO = undefined
+
+
+phoneme :: (Vector, Vector)
+phoneme = processIO stereoFromMono
+
+
+withArgs ::
+   (MakeValueTuple b) =>
+   (a, ValueTuple b) ->
+   (a, b)
+withArgs = undefined
+
+plug ::
+   (MakeValueTuple b) =>
+   (b, ValueTuple b)
+plug = undefined
+
+filterFormants :: (Float, Vector)
+filterFormants = withArgs plug
diff --git a/tests/indexed-types/should_fail/T7010.stderr 
b/tests/indexed-types/should_fail/T7010.stderr
new file mode 100644
index 0000000..25194a7
--- /dev/null
+++ b/tests/indexed-types/should_fail/T7010.stderr
@@ -0,0 +1,8 @@
+
+T7010.hs:44:27:
+    Couldn't match type `Serial (ValueTuple Float)' with `IO Float'
+    Expected type: (Float, ValueTuple Vector)
+      Actual type: (Float, ValueTuple Float)
+    In the first argument of `withArgs', namely `plug'
+    In the expression: withArgs plug
+    In an equation for `filterFormants': filterFormants = withArgs plug
diff --git a/tests/indexed-types/should_fail/all.T 
b/tests/indexed-types/should_fail/all.T
index dca20ae..d7d66df 100644
--- a/tests/indexed-types/should_fail/all.T
+++ b/tests/indexed-types/should_fail/all.T
@@ -75,5 +75,5 @@ test('T5515', normal, compile_fail, [''])
 test('T5763', expect_broken(5673), compile_fail, [''])
 test('T5934', normal, compile_fail, [''])
 test('T6123', normal, compile_fail, [''])
-
-test('ExtraTcsUntch', normal, compile_fail, [''])
\ No newline at end of file
+test('ExtraTcsUntch', normal, compile_fail, [''])
+test('T7010', normal, compile_fail, [''])
diff --git a/tests/typecheck/should_fail/T5978.hs 
b/tests/typecheck/should_fail/T5978.hs
new file mode 100644
index 0000000..2c761dd
--- /dev/null
+++ b/tests/typecheck/should_fail/T5978.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+module T5978 where
+
+class C from to | from -> to where
+
+instance C Float Char where
+instance C Double Bool where
+
+
+polyFoo :: (C from to) => from
+polyFoo = undefined
+
+polyBar ::
+   (C fromA toA, C fromB toB) =>
+   (toA -> toB) ->
+   fromA -> fromB
+polyBar = undefined
+
+
+monoBar :: Double
+monoBar = polyBar id monoFoo
+
+monoFoo :: Float
+monoFoo = polyFoo
+
diff --git a/tests/typecheck/should_fail/T5978.stderr 
b/tests/typecheck/should_fail/T5978.stderr
new file mode 100644
index 0000000..9edfde0
--- /dev/null
+++ b/tests/typecheck/should_fail/T5978.stderr
@@ -0,0 +1,10 @@
+
+T5978.hs:22:11:
+    Couldn't match type `Bool' with `Char'
+    When using functional dependencies to combine
+      C Double Bool,
+        arising from the dependency `from -> to'
+        in the instance declaration at T5978.hs:8:10
+      C Double Char, arising from a use of `polyBar' at T5978.hs:22:11-17
+    In the expression: polyBar id monoFoo
+    In an equation for `monoBar': monoBar = polyBar id monoFoo
diff --git a/tests/typecheck/should_fail/all.T 
b/tests/typecheck/should_fail/all.T
index 0d047bf..48caf69 100644
--- a/tests/typecheck/should_fail/all.T
+++ b/tests/typecheck/should_fail/all.T
@@ -274,5 +274,6 @@ test('T6001', normal, compile_fail, [''])
 test('T6022', expect_broken(6022), compile_fail, [''])
 test('T5853', normal, compile_fail, [''])
 test('T6078', normal, compile_fail, [''])
-
 test('FDsFromGivens', normal, compile_fail, [''])
+test('T5978', normal, compile_fail, [''])
+



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to