[commit: testsuite] master: Added MultiWayIf tests. (3d715a9)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/3d715a9e6cd54213f51a01e17b445f3b1be3dcf8

>---------------------------------------------------------------

commit 3d715a9e6cd54213f51a01e17b445f3b1be3dcf8
Author: Mikhail Vorozhtsov <mikhail.vorozhtsov at gmail.com>
Date:   Sun Jul 15 00:48:37 2012 +0700

    Added MultiWayIf tests.

>---------------------------------------------------------------

 tests/deSugar/should_run/DsMultiWayIf.hs           |   28 ++++++++++++++++++++
 tests/deSugar/should_run/DsMultiWayIf.stdout       |    2 +
 tests/deSugar/should_run/all.T                     |    1 +
 tests/parser/should_fail/ParserNoMultiWayIf.hs     |    7 +++++
 tests/parser/should_fail/ParserNoMultiWayIf.stderr |    3 ++
 tests/parser/should_fail/all.T                     |    1 +
 tests/parser/should_run/ParserMultiWayIf.hs        |   15 ++++++++++
 .../should_run/ParserMultiWayIf.stdout}            |    0 
 tests/parser/should_run/all.T                      |    1 +
 tests/typecheck/should_fail/TcMultiWayIfFail.hs    |    8 +++++
 .../typecheck/should_fail/TcMultiWayIfFail.stderr  |   16 +++++++++++
 tests/typecheck/should_fail/all.T                  |    1 +
 12 files changed, 83 insertions(+), 0 deletions(-)

diff --git a/tests/deSugar/should_run/DsMultiWayIf.hs b/tests/deSugar/should_run/DsMultiWayIf.hs
new file mode 100644
index 0000000..a00d797
--- /dev/null
+++ b/tests/deSugar/should_run/DsMultiWayIf.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE MultiWayIf #-}
+
+module Main where
+
+import Data.List (isSuffixOf)
+import Control.Exception
+
+errMsg = "Non-exhaustive guards in multi-way if\n"
+table  = [(1, "one"), (100, "hundred")]
+
+f t x = if | l <- length t, l > 2, l < 5 -> "length is 3 or 4"
+           | Just y <- lookup x t -> y
+           | False -> "impossible"
+           | null t -> "empty"
+
+main = do
+  print $ [ f table 1   == "one"
+          , f table 100 == "hundred"
+          , f [] 1      == "empty"
+          , f [undefined, undefined, undefined] (undefined :: Bool) ==
+              "length is 3 or 4"
+          , f ((0, "zero") : table) 100 == "length is 3 or 4"
+          ]
+  r <- try $ evaluate $ f table 99
+  print $ case r of
+    Left (PatternMatchFail s) | errMsg `isSuffixOf` s -> True
+    _                                                 -> False
+
diff --git a/tests/deSugar/should_run/DsMultiWayIf.stdout b/tests/deSugar/should_run/DsMultiWayIf.stdout
new file mode 100644
index 0000000..4097136
--- /dev/null
+++ b/tests/deSugar/should_run/DsMultiWayIf.stdout
@@ -0,0 +1,2 @@
+[True,True,True,True,True]
+True
diff --git a/tests/deSugar/should_run/all.T b/tests/deSugar/should_run/all.T
index 8e332a7..7f0df9c 100644
--- a/tests/deSugar/should_run/all.T
+++ b/tests/deSugar/should_run/all.T
@@ -39,3 +39,4 @@ 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, [''])
+test('DsMultiWayIf', if_compiler_lt('ghc', '7.5', skip), compile_and_run, [''])
diff --git a/tests/parser/should_fail/ParserNoMultiWayIf.hs b/tests/parser/should_fail/ParserNoMultiWayIf.hs
new file mode 100644
index 0000000..f9ded3d
--- /dev/null
+++ b/tests/parser/should_fail/ParserNoMultiWayIf.hs
@@ -0,0 +1,7 @@
+module ParserNoMultiWayIf where
+
+x = 123
+y = if | x < 0     -> -1
+       | x == 0    -> 0
+       | otherwise -> 1
+
diff --git a/tests/parser/should_fail/ParserNoMultiWayIf.stderr b/tests/parser/should_fail/ParserNoMultiWayIf.stderr
new file mode 100644
index 0000000..1a82362
--- /dev/null
+++ b/tests/parser/should_fail/ParserNoMultiWayIf.stderr
@@ -0,0 +1,3 @@
+
+ParserNoMultiWayIf.hs:4:5:
+    Multi-way if-expressions need -XMultiWayIf turned on
diff --git a/tests/parser/should_fail/all.T b/tests/parser/should_fail/all.T
index 592634d..355961d 100644
--- a/tests/parser/should_fail/all.T
+++ b/tests/parser/should_fail/all.T
@@ -73,5 +73,6 @@ 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('ParserNoMultiWayIf', if_compiler_lt('ghc', '7.5', skip), compile_fail, [''])
 
 test('T5425', normal, compile_fail, [''])
diff --git a/tests/parser/should_run/ParserMultiWayIf.hs b/tests/parser/should_run/ParserMultiWayIf.hs
new file mode 100644
index 0000000..83bd2e9
--- /dev/null
+++ b/tests/parser/should_run/ParserMultiWayIf.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE MultiWayIf #-}
+
+module Main where
+
+x  = 10
+x1 = if | x < 10 -> "< 10" | otherwise -> ""
+x2 = if | x < 10 -> "< 10"
+        | otherwise -> ""
+x3 = if | x < 10 -> "< 10"
+   | otherwise -> ""
+x4 = if | True -> "yes"
+x5 = if | True -> if | False -> 1 | True -> 2
+
+main = print $ x5 == 2
+
diff --git a/tests/codeGen/should_run/cgrun033.stdout b/tests/parser/should_run/ParserMultiWayIf.stdout
similarity index 100%
copy from tests/codeGen/should_run/cgrun033.stdout
copy to tests/parser/should_run/ParserMultiWayIf.stdout
diff --git a/tests/parser/should_run/all.T b/tests/parser/should_run/all.T
index 6bc63d8..03951a1 100644
--- a/tests/parser/should_run/all.T
+++ b/tests/parser/should_run/all.T
@@ -5,3 +5,4 @@ test('readRun004', normal, compile_and_run, ['-fobject-code'])
 test('T1344', normal, compile_and_run, [''])
 test('operator', normal, compile_and_run, [''])
 test('operator2', normal, compile_and_run, [''])
+test('ParserMultiWayIf', if_compiler_lt('ghc', '7.5', skip), compile_and_run, [''])
diff --git a/tests/typecheck/should_fail/TcMultiWayIfFail.hs b/tests/typecheck/should_fail/TcMultiWayIfFail.hs
new file mode 100644
index 0000000..7403d74
--- /dev/null
+++ b/tests/typecheck/should_fail/TcMultiWayIfFail.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE MultiWayIf #-}
+
+module TcMultiWayIfFail where
+
+x1 = if | True      -> 1 :: Int
+        | False     -> "2"
+        | otherwise -> [3 :: Int]
+
diff --git a/tests/typecheck/should_fail/TcMultiWayIfFail.stderr b/tests/typecheck/should_fail/TcMultiWayIfFail.stderr
new file mode 100644
index 0000000..fe53bea
--- /dev/null
+++ b/tests/typecheck/should_fail/TcMultiWayIfFail.stderr
@@ -0,0 +1,16 @@
+
+TcMultiWayIfFail.hs:6:24:
+    Couldn't match expected type `Int' with actual type `[Char]'
+    In the expression: "2"
+    In the expression:
+      if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
+    In an equation for `x1':
+        x1 = if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
+
+TcMultiWayIfFail.hs:7:24:
+    Couldn't match expected type `Int' with actual type `[Int]'
+    In the expression: [3 :: Int]
+    In the expression:
+      if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
+    In an equation for `x1':
+        x1 = if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
diff --git a/tests/typecheck/should_fail/all.T b/tests/typecheck/should_fail/all.T
index 48caf69..01e43b4 100644
--- a/tests/typecheck/should_fail/all.T
+++ b/tests/typecheck/should_fail/all.T
@@ -277,3 +277,4 @@ test('T6078', normal, compile_fail, [''])
 test('FDsFromGivens', normal, compile_fail, [''])
 test('T5978', normal, compile_fail, [''])
 
+test('TcMultiWayIfFail', if_compiler_lt('ghc', '7.5', skip), compile_fail, [''])