Added LambdaCase tests.

10 files changed, 54 insertions, 0 deletions

diff --git a/testsuite/tests/deSugar/should_run/DsLambdaCase.hs b/testsuite/tests/deSugar/should_run/DsLambdaCase.hs
new file mode 100644
index 0000000000..a49534839a
--- /dev/null
+++ b/testsuite/tests/deSugar/should_run/DsLambdaCase.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main where
+
+f = curry $ \case (Just x,  Left y)            -> Just (x, y)
+                  (Nothing, Right y) | y == 99 -> Just (0, "99")
+                  _                            -> Nothing
+
+main = print $ [ f (Just 1) (Left "Y") == Just (1, "Y")
+               , f (Just 1) (Right 99) == Nothing
+               , f Nothing  (Right 99) == Just (0, "99")
+               , f Nothing  (Right 9)  == Nothing
+               , f Nothing  (Left "Y") == Nothing ]
+
diff --git a/testsuite/tests/deSugar/should_run/DsLambdaCase.stdout b/testsuite/tests/deSugar/should_run/DsLambdaCase.stdout
new file mode 100644
index 0000000000..9adb27b5bc
--- /dev/null
+++ b/testsuite/tests/deSugar/should_run/DsLambdaCase.stdout
@@ -0,0 +1 @@
+[True,True,True,True,True]
diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T
index 31b08780ff..8e332a715e 100644
--- a/testsuite/tests/deSugar/should_run/all.T
+++ b/testsuite/tests/deSugar/should_run/all.T
@@ -38,3 +38,4 @@ test('mc06', normal, compile_and_run, [''])
 test('mc07', normal, compile_and_run, [''])
 test('mc08', normal, compile_and_run, [''])
 test('T5742', normal, compile_and_run, [''])
+test('DsLambdaCase', if_compiler_lt('ghc', '7.5', skip), compile_and_run, [''])
diff --git a/testsuite/tests/parser/should_compile/ParserLambdaCase.hs b/testsuite/tests/parser/should_compile/ParserLambdaCase.hs
new file mode 100644
index 0000000000..006800788e
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/ParserLambdaCase.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE LambdaCase #-}
+
+module ParserLambdaCase where
+
+f1 = \case "1" -> 1
+f2 = \ {- comment1 {- comment2 -} -} case "1" -> 1; "2" -> 2
+f3 = \ -- comment
+       case "1" -> 1
+            "2" -> 2
+f4 = \casex -> casex
+f5 = \ case { "1" -> 1; "2" -> 2 }
+
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 0ac301ede1..083b38c898 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -90,6 +90,7 @@ test('NondecreasingIndentation', normal, compile, [''])
 test('mc15', normal, compile, [''])
 test('mc16', normal, compile, [''])
 test('EmptyDecls', normal, compile, [''])
+test('ParserLambdaCase', if_compiler_lt('ghc', '7.5', skip), compile, [''])
 
 test('T5243', extra_clean(['T5243A.hi', 'T5243A.o']),
      multimod_compile, ['T5243',''])
diff --git a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs
new file mode 100644
index 0000000000..d87f8f0390
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs
@@ -0,0 +1,4 @@
+module ParserNoLambdaCase where
+
+f = \case "1" -> 1
+
diff --git a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
new file mode 100644
index 0000000000..11f087896b
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
@@ -0,0 +1,2 @@
+
+ParserNoLambdaCase.hs:3:6: parse error on input `case'
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 0e94f1a6f8..592634d2dd 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -72,5 +72,6 @@ test('NondecreasingIndentationFail', normal, compile_fail, [''])
 test('readFailTraditionalRecords1', normal, compile_fail, [''])
 test('readFailTraditionalRecords2', normal, compile_fail, [''])
 test('readFailTraditionalRecords3', normal, compile_fail, [''])
+test('ParserNoLambdaCase', if_compiler_lt('ghc', '7.5', skip), compile_fail, [''])
 
 test('T5425', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_compile/TcLambdaCase.hs b/testsuite/tests/typecheck/should_compile/TcLambdaCase.hs
new file mode 100644
index 0000000000..1ac6348c29
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/TcLambdaCase.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE LambdaCase #-}
+
+module TcLambdaCase where
+
+import Data.Bits ((.|.))
+
+f1 :: (a -> a) -> (a -> a)
+f1 = \case x -> x
+
+f2 :: Num a => a -> a
+f2 = \case x -> x + x
+
+f3 :: Int -> (Int, Int)
+f3 = (\case y -> (y + y, y * y)) . (.|. 12)
+
+f4 = \case _ -> undefined
+
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 5a0e36efec..7817cdfc6e 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -380,3 +380,4 @@ test('T6055', normal, compile, [''])
 test('DfltProb1', normal, compile, [''])
 test('DfltProb2', normal, compile, [''])
 test('T6134', normal, compile, [''])
+test('TcLambdaCase', if_compiler_lt('ghc', '7.5', skip), compile, [''])