Tests for Trac 2030

testsuite/tests/ghc-regress/typecheck/should_compile/all.T

@@ -256,6 +256,8 @@ test('tc239', extra_clean(['Tc239_Help.hi', 'Tc239_Help.o']),
      multimod_compile, ['tc239', '-v0'])
      
 test('tc240', if_compiler_lt('ghc', '6.9', skip), compile, [''])
+test('tc241', normal, compile, [''])
+test('tc242', normal, compile, [''])
 
 test('FD1', normal, compile_fail, [''])
 test('FD2', normal, compile_fail, [''])

testsuite/tests/ghc-regress/typecheck/should_compile/tc242.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+module Bug where
+
+f1 :: forall a. [a] -> [a]
+f1 (x:xs) = xs ++ [ x :: a ]   -- OK
+
+f2 :: forall a. [a] -> [a]
+f2 = \(x:xs) -> xs ++ [ x :: a ]   -- OK
+
+-- This pair is a cut-down version of Trac #2030
+isSafe alts = isSafeAlts alts
+
+isSafeAlts :: forall m . Int -> m Int
+isSafeAlts x = error "urk"
+  where
+    isSafeAlt :: Int -> m Int
+    isSafeAlt alt = isSafe `seq` error "urk"
+

testsuite/tests/ghc-regress/typecheck/should_fail/all.T

@@ -186,3 +186,4 @@ test('tcfail194', if_compiler_lt('ghc', '6.9', skip), compile_fail, [''])
 test('tcfail195', normal, compile_fail, [''])
 test('tcfail196', normal, compile_fail, [''])
 test('tcfail197', normal, compile_fail, [''])
+test('tcfail198', normal, compile_fail, [''])

testsuite/tests/ghc-regress/typecheck/should_fail/tcfail198.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+
+module ShouldFail where
+
+  f3 :: forall a. [a] -> [a] 
+  Just f3 = Just (\(x:xs) -> xs ++ [ x :: a ])   -- Not OK!
+	-- The type variable does not scope in a pattern binding

testsuite/tests/ghc-regress/typecheck/should_fail/tcfail198.stderr

+
+tcfail198.hs:6:37:
+    Couldn't match expected type `a1' against inferred type `a'
+      `a1' is a rigid type variable bound by
+           the polymorphic type `forall a1. a1' at tcfail198.hs:6:37
+      `a' is a rigid type variable bound by
+          the polymorphic type `forall a. [a] -> [a]' at tcfail198.hs:6:18
+    In the expression: x :: a
+    In the second argument of `(++)', namely `[x :: a]'
+    In the expression: xs ++ [x :: a]