Repository : ssh://darcs.haskell.org//srv/darcs/testsuite
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/90b1a383b17c14c7f50895bdc74aa333d4cd94f7
>---------------------------------------------------------------
commit 90b1a383b17c14c7f50895bdc74aa333d4cd94f7
Author: Dimitrios.Vytiniotis <dimitris at microsoft.com>
Date: Fri Jun 8 15:50:56 2012 +0100
Testcases for floating equalities ouf of implications
and for recording extra untouchable variables.
>---------------------------------------------------------------
tests/gadt/FloatEq.hs | 17 ++++++++++
tests/gadt/all.T | 2 +
tests/indexed-types/should_fail/ExtraTcsUntch.hs | 33 ++++++++++++++++++++
.../indexed-types/should_fail/ExtraTcsUntch.stderr | 11 ++++++
4 files changed, 63 insertions(+), 0 deletions(-)
diff --git a/tests/gadt/FloatEq.hs b/tests/gadt/FloatEq.hs
new file mode 100644
index 0000000..d5b5fca
--- /dev/null
+++ b/tests/gadt/FloatEq.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE GADTs #-}
+module FloatEq where
+
+
+data T a where
+ T1 :: T Int
+ T2 :: T a
+
+
+h :: T a -> a -> Int
+h = undefined
+
+
+f x y = case x of
+ T1 -> y::Int
+ T2 -> h x y
+
diff --git a/tests/gadt/all.T b/tests/gadt/all.T
index 59e4d2e..d846c64 100644
--- a/tests/gadt/all.T
+++ b/tests/gadt/all.T
@@ -111,3 +111,5 @@ test('T5424',
extra_clean(['T5424a.hi', 'T5424a.o']),
multimod_compile,
['T5424', '-v0 -O0'])
+
+test('FloatEq', normal, compile, [''])
\ No newline at end of file
diff --git a/tests/indexed-types/should_fail/ExtraTcsUntch.hs b/tests/indexed-types/should_fail/ExtraTcsUntch.hs
new file mode 100644
index 0000000..e399195
--- /dev/null
+++ b/tests/indexed-types/should_fail/ExtraTcsUntch.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE TypeFamilies, FunctionalDependencies, FlexibleContexts, GADTs, ScopedTypeVariables #-}
+
+module ExtraTcsUntch where
+
+
+class C x y | x -> y where
+ op :: x -> y -> ()
+
+instance C [a] [a]
+
+type family F a :: *
+
+h :: F Int -> ()
+h = undefined
+
+data TEx where
+ TEx :: a -> TEx
+
+
+f (x::beta) =
+ let g1 :: forall b. b -> ()
+ g1 _ = h [x]
+ g2 z = case z of TEx y -> (h [[undefined]], op x [y])
+ in (g1 '3', g2 undefined)
+
+
+{- This example comes from Note [Extra TcS Untouchables] in TcSimplify. It demonstrates
+ why when floating equalities out of an implication constraint we must record the free
+ variables of the equalities as untouchables. With GHC 7.4.1 this program gives a Core
+ Lint error because of an existential escaping. -}
+
+
+
diff --git a/tests/indexed-types/should_fail/ExtraTcsUntch.stderr b/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
new file mode 100644
index 0000000..c5d97ae
--- /dev/null
+++ b/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
@@ -0,0 +1,11 @@
+
+ExtraTcsUntch.hs:23:53:
+ Could not deduce (C [t] [a]) arising from a use of `op'
+ from the context (beta ~ [t], F Int ~ [[t]])
+ bound by the inferred type of
+ f :: (beta ~ [t], F Int ~ [[t]]) => beta -> ((), ((), ()))
+ at ExtraTcsUntch.hs:(20,1)-(24,29)
+ Possible fix: add an instance declaration for (C [t] [a])
+ In the expression: op x [y]
+ In the expression: (h [[undefined]], op x [y])
+ In a case alternative: TEx y -> (h [[undefined]], op x [y])