From 0d36d57bdec06730cc335d0c5ac5409b68bc38a5 Mon Sep 17 00:00:00 2001
From: "Dimitrios.Vytiniotis" <dimitris@microsoft.com>
Date: Fri, 8 Jun 2012 15:50:56 +0100
Subject: Testcases for floating equalities ouf of implications and for
 recording extra untouchable variables.

---
 testsuite/tests/gadt/FloatEq.hs                    | 17 +++++++++++
 testsuite/tests/gadt/all.T                         |  2 ++
 .../indexed-types/should_fail/ExtraTcsUntch.hs     | 33 ++++++++++++++++++++++
 .../indexed-types/should_fail/ExtraTcsUntch.stderr | 11 ++++++++
 4 files changed, 63 insertions(+)
 create mode 100644 testsuite/tests/gadt/FloatEq.hs
 create mode 100644 testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs
 create mode 100644 testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr

(limited to 'testsuite')

diff --git a/testsuite/tests/gadt/FloatEq.hs b/testsuite/tests/gadt/FloatEq.hs
new file mode 100644
index 0000000000..d5b5fca3d8
--- /dev/null
+++ b/testsuite/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/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T
index 59e4d2e790..d846c64ee1 100644
--- a/testsuite/tests/gadt/all.T
+++ b/testsuite/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/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs b/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs
new file mode 100644
index 0000000000..e399195d9a
--- /dev/null
+++ b/testsuite/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/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr b/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
new file mode 100644
index 0000000000..c5d97ae288
--- /dev/null
+++ b/testsuite/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])
-- 
cgit v1.2.1