Added LambdaCase tests.
authorMikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
Fri, 13 Jul 2012 13:48:45 +0000 (20:48 +0700)
committerSimon Marlow <marlowsd@gmail.com>
Mon, 16 Jul 2012 10:10:52 +0000 (11:10 +0100)
testsuite/tests/deSugar/should_run/DsLambdaCase.hs [new file with mode: 0644]
testsuite/tests/deSugar/should_run/DsLambdaCase.stdout [new file with mode: 0644]
testsuite/tests/deSugar/should_run/all.T
testsuite/tests/parser/should_compile/ParserLambdaCase.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/all.T
testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/all.T
testsuite/tests/typecheck/should_compile/TcLambdaCase.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

diff --git a/testsuite/tests/deSugar/should_run/DsLambdaCase.hs b/testsuite/tests/deSugar/should_run/DsLambdaCase.hs
new file mode 100644 (file)
index 0000000..a495348
--- /dev/null
@@ -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 (file)
index 0000000..9adb27b
--- /dev/null
@@ -0,0 +1 @@
+[True,True,True,True,True]
index 31b0878..8e332a7 100644 (file)
@@ -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 (file)
index 0000000..0068007
--- /dev/null
@@ -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 }
+
index 0ac301e..083b38c 100644 (file)
@@ -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 (file)
index 0000000..d87f8f0
--- /dev/null
@@ -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 (file)
index 0000000..11f0878
--- /dev/null
@@ -0,0 +1,2 @@
+
+ParserNoLambdaCase.hs:3:6: parse error on input `case'
index 0e94f1a..592634d 100644 (file)
@@ -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 (file)
index 0000000..1ac6348
--- /dev/null
@@ -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
+
index 5a0e36e..7817cdf 100644 (file)
@@ -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, [''])