diff options
Diffstat (limited to 'testsuite/tests/deSugar/should_run')
75 files changed, 851 insertions, 0 deletions
diff --git a/testsuite/tests/deSugar/should_run/Makefile b/testsuite/tests/deSugar/should_run/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/deSugar/should_run/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/deSugar/should_run/T246.hs b/testsuite/tests/deSugar/should_run/T246.hs new file mode 100644 index 0000000000..835e618b79 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T246.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- Test Trac #246 + +module Main where + +import Control.Exception + +data T = T { x :: Bool, y :: Bool } + +f (T { y=True, x=True }) = "Odd" +f _ = "OK" + +g (T { x=True, y=True }) = "Odd2" +g _ = "Odd3" + +funny = T { x = undefined, y = False } + +main = do { print (f funny) -- Should work, because we test + -- y first, which fails, and falls + -- through to "OK" + + ; Control.Exception.catch + (print (g funny)) -- Should fail, because we test + (\(_::SomeException) -> print "caught") -- x first, and hit "undefined" + } diff --git a/testsuite/tests/deSugar/should_run/T246.stdout b/testsuite/tests/deSugar/should_run/T246.stdout new file mode 100644 index 0000000000..f266ecc65d --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T246.stdout @@ -0,0 +1,2 @@ +"OK" +"caught" diff --git a/testsuite/tests/deSugar/should_run/T3126.hs b/testsuite/tests/deSugar/should_run/T3126.hs new file mode 100644 index 0000000000..811ddc1fa7 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T3126.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +module Main where +import Data.String + +-- {{{ Num literals +newtype N = N Int deriving (Show,Eq) + +instance Num N where + fromInteger 0 = error "0" + fromInteger 1 = N 0 + fromInteger _ = N 1 + +f x = case x of + 1 -> False + 0 -> True + +g x = case x of + 1 -> False + _ -> case x of + 0 -> True + _ -> error "No match" + +testNum = do + print $ g (N 0) + print $ f (N 0) + +-- }}} + +-- {{{ IsString literals +newtype S = S String deriving Eq + +instance IsString S where + fromString [] = error "[]" + fromString (_:_) = S "." + +fs x = case x of + "." -> False + "" -> True + +gs x = case x of + "." -> False + _ -> case x of + "" -> True + _ -> error "No match" + +testIsString = do + print $ gs (S ".") + print $ fs (S ".") + +-- }}} + +main = do { testNum; testIsString } + diff --git a/testsuite/tests/deSugar/should_run/T3126.stdout b/testsuite/tests/deSugar/should_run/T3126.stdout new file mode 100644 index 0000000000..3367978a7b --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T3126.stdout @@ -0,0 +1,4 @@ +False +False +False +False diff --git a/testsuite/tests/deSugar/should_run/T3382.hs b/testsuite/tests/deSugar/should_run/T3382.hs new file mode 100644 index 0000000000..800256a1f0 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T3382.hs @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -XOverloadedStrings #-}
+module Main where
+
+import Data.String
+
+instance IsString Int where
+ fromString x = 1337
+
+f :: Int -> String
+f "hello" = "correct"
+f _ = "false"
+
+main = do print $ f 1337
+ print $ f 1338
diff --git a/testsuite/tests/deSugar/should_run/T3382.stdout b/testsuite/tests/deSugar/should_run/T3382.stdout new file mode 100644 index 0000000000..a92f13b57a --- /dev/null +++ b/testsuite/tests/deSugar/should_run/T3382.stdout @@ -0,0 +1,2 @@ +"correct"
+"false"
diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T new file mode 100644 index 0000000000..9c8664d64b --- /dev/null +++ b/testsuite/tests/deSugar/should_run/all.T @@ -0,0 +1,39 @@ +# Args to compile_and_run are: +# extra compile flags +# extra run flags +# expected process return value, if not zero + +test('dsrun001', normal, compile_and_run, ['']) +test('dsrun002', normal, compile_and_run, ['']) +test('dsrun003', normal, compile_and_run, ['']) +test('dsrun004', normal, compile_and_run, ['']) +test('dsrun005', exit_code(1), compile_and_run, ['']) +test('dsrun006', normal, compile_and_run, ['']) +test('dsrun007', exit_code(1), compile_and_run, ['']) +test('dsrun008', exit_code(1), compile_and_run, ['']) +test('dsrun009', normal, compile_and_run, ['']) +test('dsrun010', normal, compile_and_run, ['']) +test('dsrun011', skip_if_fast, compile_and_run, ['']) +test('dsrun012', skip_if_fast, compile_and_run, ['']) +test('dsrun013', normal, compile_and_run, ['']) +test('dsrun014', expect_broken_for(1257, ['ghci']), compile_and_run, ['']) +test('dsrun015', normal, compile_and_run, ['']) +test('dsrun016', normal, compile_and_run, ['']) +test('dsrun017', normal, compile_and_run, ['']) +test('dsrun018', normal, compile_and_run, ['']) +test('dsrun019', normal, compile_and_run, ['']) +test('dsrun020', normal, compile_and_run, ['']) +test('dsrun021', normal, compile_and_run, ['']) +test('dsrun022', normal, compile_and_run, ['']) +test('dsrun023', normal, compile_and_run, ['']) +test('T246', normal, compile_and_run, ['']) +test('T3126', normal, compile_and_run, ['']) +test('T3382', normal, compile_and_run, ['']) +test('mc01', normal, compile_and_run, ['']) +test('mc02', normal, compile_and_run, ['']) +test('mc03', normal, compile_and_run, ['']) +test('mc04', normal, compile_and_run, ['']) +test('mc05', normal, compile_and_run, ['']) +test('mc06', normal, compile_and_run, ['']) +test('mc07', normal, compile_and_run, ['']) +test('mc08', normal, compile_and_run, ['']) diff --git a/testsuite/tests/deSugar/should_run/dsrun001.hs b/testsuite/tests/deSugar/should_run/dsrun001.hs new file mode 100644 index 0000000000..e40ea2a11d --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun001.hs @@ -0,0 +1,12 @@ +{- Check that list comprehensions can be written + in do-notation. This actually broke 2.02, with + a pattern match failure in dsListComp! +-} + +module Main where + +main = putStrLn (show theList) +theList = do x <- [1..3] + y <- [1..3] + return (x,y) + diff --git a/testsuite/tests/deSugar/should_run/dsrun001.stdout b/testsuite/tests/deSugar/should_run/dsrun001.stdout new file mode 100644 index 0000000000..a375d0fe24 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun001.stdout @@ -0,0 +1 @@ +[(1,1),(1,2),(1,3),(2,1),(2,2),(2,3),(3,1),(3,2),(3,3)] diff --git a/testsuite/tests/deSugar/should_run/dsrun002.hs b/testsuite/tests/deSugar/should_run/dsrun002.hs new file mode 100644 index 0000000000..acad275f74 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun002.hs @@ -0,0 +1,14 @@ +{- Tests let-expressions in do-statments -} + +module Main( main ) where + +foo = do + putStr "a" + let x = "b" in putStr x + putStr "c" + +main = do + putStr "a" + foo + let x = "b" in putStrLn x + diff --git a/testsuite/tests/deSugar/should_run/dsrun002.stdout b/testsuite/tests/deSugar/should_run/dsrun002.stdout new file mode 100644 index 0000000000..660eacecf5 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun002.stdout @@ -0,0 +1 @@ +aabcb diff --git a/testsuite/tests/deSugar/should_run/dsrun003.hs b/testsuite/tests/deSugar/should_run/dsrun003.hs new file mode 100644 index 0000000000..d100bff718 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun003.hs @@ -0,0 +1,13 @@ +-- Tests match on empty field lists + +module Main where + +data Person = Female {firstName, lastName :: String} + | Male {firstName, lastName :: String} + deriving (Show) + +isFemale (Female{}) = True +isFemale (Male{}) = False + +main = print (isFemale (Female {firstName = "Jane", lastName = "Smith"})) + diff --git a/testsuite/tests/deSugar/should_run/dsrun003.stdout b/testsuite/tests/deSugar/should_run/dsrun003.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun003.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/deSugar/should_run/dsrun004.hs b/testsuite/tests/deSugar/should_run/dsrun004.hs new file mode 100644 index 0000000000..8f54e330e1 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun004.hs @@ -0,0 +1,13 @@ +-- Test n+k patterns + +{-# LANGUAGE NPlusKPatterns #-} + +module Main where + +f (n+1) = n + +g :: Int -> Int +g (n+4) = n + +main = print (f 3) >> + print (g 9) diff --git a/testsuite/tests/deSugar/should_run/dsrun004.stdout b/testsuite/tests/deSugar/should_run/dsrun004.stdout new file mode 100644 index 0000000000..49ae94bb33 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun004.stdout @@ -0,0 +1,2 @@ +2 +5 diff --git a/testsuite/tests/deSugar/should_run/dsrun005.hs b/testsuite/tests/deSugar/should_run/dsrun005.hs new file mode 100644 index 0000000000..238a2c3410 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun005.hs @@ -0,0 +1,46 @@ +{- + +From: Olaf Chitil <chitil@Informatik.RWTH-Aachen.DE> + +It is a problem with 0.29 (which we use for compiling 2.01), it is gone +in 2.01. + + f :: Eq a => a -> [b] -> [b] -> Bool + f a [] [] = (a==a) + main = print (f True "" "Hallo") + + +when run after compilation with 0.29 you get: +Fail: "test.hs", line 6: incomplete pattern(s) to match in function "ds.d5b4" + +while 2.01 gives you as desired +Fail: In pattern-matching: function f{-aYw-}; at test.hs, line 6 + +The problem is the dictionary, because for the program + + f :: a -> [b] -> [b] -> Bool + f a [] [] = True + main = print (f True "" "Hallo") + +0.29 gives the function name "f" as well. + +So it's ok in 2.01, but why did you change the form of the error messages? +"incomplete pattern(s) to match" is more informative then "In pattern-matching"! +I even prefer the order of information in the 0.29 error messages. + +May I finally repeat that in my opinion the compiler should warn about +incomplete patterns during compilation. However, I suppose the +incomplete patterns are just recognised by the desugarer which does +not produce error messages any more. + +-} + + +module Main where + +f :: Eq a => a -> [b] -> [b] -> Bool +f a [] [] = (a==a) + +main = print (f True "" "Hallo") + + diff --git a/testsuite/tests/deSugar/should_run/dsrun005.stderr b/testsuite/tests/deSugar/should_run/dsrun005.stderr new file mode 100644 index 0000000000..73718fc858 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun005.stderr @@ -0,0 +1,2 @@ +dsrun005: dsrun005.hs:42:1-18: Non-exhaustive patterns in function f + diff --git a/testsuite/tests/deSugar/should_run/dsrun005.stderr-hugs b/testsuite/tests/deSugar/should_run/dsrun005.stderr-hugs new file mode 100644 index 0000000000..e9fed4ae3a --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun005.stderr-hugs @@ -0,0 +1 @@ +dsrun005: pattern match failure diff --git a/testsuite/tests/deSugar/should_run/dsrun005.stdout b/testsuite/tests/deSugar/should_run/dsrun005.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun005.stdout diff --git a/testsuite/tests/deSugar/should_run/dsrun006.hs b/testsuite/tests/deSugar/should_run/dsrun006.hs new file mode 100644 index 0000000000..759c9c542d --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun006.hs @@ -0,0 +1,33 @@ +{- +Date: Tue, 20 May 1997 05:10:04 GMT +From: Tomasz Cholewo <tjchol01@mecca.spd.louisville.edu> + +ghc-2.03 cannot compile the following code, which I think is correct +according to the Report + + data X = A {a :: Int} | B {a :: Int} + +The error message is: + + Conflicting definitions for: a + Defined at bug4.lhs:2 + Defined at bug4.lhs:2 + +In addition the following snippet + + data X = A {a :: Int} + y = let A {a} = x + in a + +fails with: + + bug4.lhs:4:5: Not a valid LHS on input: "in" +-} +--module Main(main) where + +data X = A {a :: Int} | B {a :: Int} + +f x = let A {a=a} = x + in a + +main = print (f (A {a = 3})) diff --git a/testsuite/tests/deSugar/should_run/dsrun006.stdout b/testsuite/tests/deSugar/should_run/dsrun006.stdout new file mode 100644 index 0000000000..00750edc07 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun006.stdout @@ -0,0 +1 @@ +3 diff --git a/testsuite/tests/deSugar/should_run/dsrun007.hs b/testsuite/tests/deSugar/should_run/dsrun007.hs new file mode 100644 index 0000000000..19a0c641cb --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun007.hs @@ -0,0 +1,5 @@ +data T = C Int + +unpick (C i) = i + 1 + +main = print (unpick (C{}))
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun007.stderr b/testsuite/tests/deSugar/should_run/dsrun007.stderr new file mode 100644 index 0000000000..f313633803 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun007.stderr @@ -0,0 +1,2 @@ +dsrun007: dsrun007.hs:5:23-25: Missing field in record construction + diff --git a/testsuite/tests/deSugar/should_run/dsrun007.stderr-hugs b/testsuite/tests/deSugar/should_run/dsrun007.stderr-hugs new file mode 100644 index 0000000000..8941f55132 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun007.stderr-hugs @@ -0,0 +1 @@ +dsrun007: undefined field: C diff --git a/testsuite/tests/deSugar/should_run/dsrun008.hs b/testsuite/tests/deSugar/should_run/dsrun008.hs new file mode 100644 index 0000000000..c055da563c --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun008.hs @@ -0,0 +1,2 @@ +-- !!! Double irrefutable pattern (bug in Hugs98, 29/8/2001) +main = print (case (1,2) of ~(~(2,x)) -> x) diff --git a/testsuite/tests/deSugar/should_run/dsrun008.stderr b/testsuite/tests/deSugar/should_run/dsrun008.stderr new file mode 100644 index 0000000000..ff7de054f2 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun008.stderr @@ -0,0 +1,2 @@ +dsrun008: dsrun008.hs:2:15-42: Irrefutable pattern failed for pattern (2, x) + diff --git a/testsuite/tests/deSugar/should_run/dsrun008.stderr-hugs b/testsuite/tests/deSugar/should_run/dsrun008.stderr-hugs new file mode 100644 index 0000000000..18ee3730c2 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun008.stderr-hugs @@ -0,0 +1 @@ +dsrun008: pattern match failure diff --git a/testsuite/tests/deSugar/should_run/dsrun009.hs b/testsuite/tests/deSugar/should_run/dsrun009.hs new file mode 100644 index 0000000000..104f1af2e3 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun009.hs @@ -0,0 +1,16 @@ +-- !!! Test that 'negate' is used properly to construct negative literals + +main = print (minusTwo,trueOrFalse) + +minusTwo = -2::N + +trueOrFalse = + case minusTwo of + -2 -> True + _ -> False + +data N = Negate N | FromInteger Integer deriving (Eq,Show) + +instance Num N where + negate = Negate + fromInteger = FromInteger diff --git a/testsuite/tests/deSugar/should_run/dsrun009.stdout b/testsuite/tests/deSugar/should_run/dsrun009.stdout new file mode 100644 index 0000000000..1f0a31b942 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun009.stdout @@ -0,0 +1 @@ +(Negate (FromInteger 2),True) diff --git a/testsuite/tests/deSugar/should_run/dsrun010.hs b/testsuite/tests/deSugar/should_run/dsrun010.hs new file mode 100644 index 0000000000..99a9297f8b --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun010.hs @@ -0,0 +1,22 @@ +-- Check that pattern match failure in do-notation +-- is reflected by calling the monadic 'fail', not by a +-- runtime exception + +import Control.Monad +import Data.Maybe + +test :: (MonadPlus m) => [a] -> m Bool +test xs + = do + (_:_) <- return xs + -- Should fail here + return True + `mplus` + -- Failure in LH arg should trigger RH arg + do + return False + +main :: IO () +main + = do let x = fromJust (test []) + putStrLn (show x) diff --git a/testsuite/tests/deSugar/should_run/dsrun010.stdout b/testsuite/tests/deSugar/should_run/dsrun010.stdout new file mode 100644 index 0000000000..bc59c12aa1 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun010.stdout @@ -0,0 +1 @@ +False diff --git a/testsuite/tests/deSugar/should_run/dsrun011.hs b/testsuite/tests/deSugar/should_run/dsrun011.hs new file mode 100644 index 0000000000..b7e518c0bf --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun011.hs @@ -0,0 +1,93 @@ +-- Test desugaring of mutual recursion of many functions +-- which generated a big-tuple link error in GHC 6.0 + +module Main where + + +a1 :: Num a => a -> a + +a1 x | x==0 = x +a1 x = 1 + k8 (x-1) + +a2 x = 1 + a1 x +a3 x = 1 + a2 x +a4 x = 1 + a3 x +a5 x = 1 + a4 x +a6 x = 1 + a5 x +a7 x = 1 + a6 x +a8 x = 1 + a7 x + +b1 x = 1 + a8 x +b2 x = 1 + b1 x +b3 x = 1 + b2 x +b4 x = 1 + b3 x +b5 x = 1 + b4 x +b6 x = 1 + b5 x +b7 x = 1 + b6 x +b8 x = 1 + b7 x + +c1 x = 1 + b8 x +c2 x = 1 + c1 x +c3 x = 1 + c2 x +c4 x = 1 + c3 x +c5 x = 1 + c4 x +c6 x = 1 + c5 x +c7 x = 1 + c6 x +c8 x = 1 + c7 x + +d1 x = 1 + c8 x +d2 x = 1 + d1 x +d3 x = 1 + d2 x +d4 x = 1 + d3 x +d5 x = 1 + d4 x +d6 x = 1 + d5 x +d7 x = 1 + d6 x +d8 x = 1 + d7 x + +e1 x = 1 + d8 x +e2 x = 1 + e1 x +e3 x = 1 + e2 x +e4 x = 1 + e3 x +e5 x = 1 + e4 x +e6 x = 1 + e5 x +e7 x = 1 + e6 x +e8 x = 1 + e7 x + +f1 x = 1 + e8 x +f2 x = 1 + f1 x +f3 x = 1 + f2 x +f4 x = 1 + f3 x +f5 x = 1 + f4 x +f6 x = 1 + f5 x +f7 x = 1 + f6 x +f8 x = 1 + f7 x + +g1 x = 1 + f8 x +g2 x = 1 + g1 x +g3 x = 1 + g2 x +g4 x = 1 + g3 x +g5 x = 1 + g4 x +g6 x = 1 + g5 x +g7 x = 1 + g6 x +g8 x = 1 + g7 x + +h1 x = 1 + g8 x +h2 x = 1 + h1 x +h3 x = 1 + h2 x +h4 x = 1 + h3 x +h5 x = 1 + h4 x +h6 x = 1 + h5 x +h7 x = 1 + h6 x +h8 x = 1 + h7 x + +k1 x = 1 + h8 x +k2 x = 1 + k1 x +k3 x = 1 + k2 x +k4 x = 1 + k3 x +k5 x = 1 + k4 x +k6 x = 1 + k5 x +k7 x = 1 + k6 x +k8 x = 1 + k7 x + + +main = print (a1 3)
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun011.stdout b/testsuite/tests/deSugar/should_run/dsrun011.stdout new file mode 100644 index 0000000000..a817176f4a --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun011.stdout @@ -0,0 +1 @@ +216 diff --git a/testsuite/tests/deSugar/should_run/dsrun012.hs b/testsuite/tests/deSugar/should_run/dsrun012.hs new file mode 100644 index 0000000000..52ebd160e3 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun012.hs @@ -0,0 +1,12 @@ +-- Desugaring of massive pattern bindings +-- Fails in GHC 6.0 without -O + +module Main where + +[a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17, + a18,a19,a20,a21,a22,a23,a24,a25,a26,a27,a28,a29,a30,a31,a32, + a33,a34,a35,a36,a37,a38,a39,a40,a41,a42,a43,a44,a45,a46,a47, + a48,a49,a50,a51,a52,a53,a54,a55,a56,a57,a58,a59,a60,a61,a62,a63] = + [0..63] + +main = print a62 diff --git a/testsuite/tests/deSugar/should_run/dsrun012.stdout b/testsuite/tests/deSugar/should_run/dsrun012.stdout new file mode 100644 index 0000000000..a8fa06e1be --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun012.stdout @@ -0,0 +1 @@ +62 diff --git a/testsuite/tests/deSugar/should_run/dsrun013.hs b/testsuite/tests/deSugar/should_run/dsrun013.hs new file mode 100644 index 0000000000..c9cc59ead9 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun013.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE UnboxedTuples #-} + +-- This one killed GHC 6.4.1, because the pattern match on the +-- unboxed tuple generates a failure case, which defeated the +-- rather fragile code in the desugarer +-- See DsExpr.lhs, the HsCase case + +module Main where + +foo xs ys = case (# null xs, null ys #) of + (# True, False #) -> "One" + (# False, True #) -> "Two" + +main :: IO () +main = print (foo [] "ok") + diff --git a/testsuite/tests/deSugar/should_run/dsrun013.stdout b/testsuite/tests/deSugar/should_run/dsrun013.stdout new file mode 100644 index 0000000000..2dcddd2593 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun013.stdout @@ -0,0 +1 @@ +"One" diff --git a/testsuite/tests/deSugar/should_run/dsrun014.hs b/testsuite/tests/deSugar/should_run/dsrun014.hs new file mode 100644 index 0000000000..3b08a7ebf0 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun014.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE UnboxedTuples #-} + +module Main where + +import Debug.Trace + +{-# NOINLINE f #-} +f :: a -> b -> (# a,b #) +f x y = x `seq` y `seq` (# x,y #) + +g :: Int -> Int -> Int +g v w = case f v w of + (# a,b #) -> a+b + +main = print (g (trace "one" 1) (trace "two" 2)) +-- The args should be evaluated in the right order! diff --git a/testsuite/tests/deSugar/should_run/dsrun014.stderr b/testsuite/tests/deSugar/should_run/dsrun014.stderr new file mode 100644 index 0000000000..814f4a4229 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun014.stderr @@ -0,0 +1,2 @@ +one +two diff --git a/testsuite/tests/deSugar/should_run/dsrun014.stdout b/testsuite/tests/deSugar/should_run/dsrun014.stdout new file mode 100644 index 0000000000..00750edc07 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun014.stdout @@ -0,0 +1 @@ +3 diff --git a/testsuite/tests/deSugar/should_run/dsrun015.hs b/testsuite/tests/deSugar/should_run/dsrun015.hs new file mode 100644 index 0000000000..da5e443605 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun015.hs @@ -0,0 +1,34 @@ +{-# OPTIONS_GHC -XRecordWildCards -XNamedFieldPuns #-} + +-- This is a very partial test of the record-wildcard extension +-- but better than nothing + +module Main where + +data T = C { x :: Int, y :: Int } + | D { x :: Int, b :: Bool } + +select :: T -> Int +select = x + +f :: (T,T) -> Int +f v = let (C {..}, d) = v in Main.x d + +mkC a = + let x = a + 1 + y = a * 2 + in C{..} + +sumC C{..} = x + y + +foo x b = + let y = x+1 + in (C{..}, let x = 100 in D{..}) + +bar a = + let (C{..}, d) = a + in (x + y + Main.x d, let D{..} = d in b) + +main = do + print $ sumC $ mkC 10 + print $ bar $ foo 5 True diff --git a/testsuite/tests/deSugar/should_run/dsrun015.stdout b/testsuite/tests/deSugar/should_run/dsrun015.stdout new file mode 100644 index 0000000000..b085e1acb0 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun015.stdout @@ -0,0 +1,2 @@ +31 +(111,True) diff --git a/testsuite/tests/deSugar/should_run/dsrun016.hs b/testsuite/tests/deSugar/should_run/dsrun016.hs new file mode 100644 index 0000000000..38747a46e3 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun016.hs @@ -0,0 +1,14 @@ +-- Tests grouping WITH a using clause but WITHOUT a by clause + +{-# OPTIONS_GHC -XTransformListComp #-} + +module Main where + +import Data.List(inits) + +main = putStrLn (show output) + where + output = [ x + | y <- [1..3] + , x <- "hello" + , then group using inits ] diff --git a/testsuite/tests/deSugar/should_run/dsrun016.stdout b/testsuite/tests/deSugar/should_run/dsrun016.stdout new file mode 100644 index 0000000000..60b1b8058e --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun016.stdout @@ -0,0 +1 @@ +["","h","he","hel","hell","hello","helloh","hellohe","hellohel","hellohell","hellohello","hellohelloh","hellohellohe","hellohellohel","hellohellohell","hellohellohello"] diff --git a/testsuite/tests/deSugar/should_run/dsrun017.hs b/testsuite/tests/deSugar/should_run/dsrun017.hs new file mode 100644 index 0000000000..877db7823c --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun017.hs @@ -0,0 +1,13 @@ +-- Tests grouping WITH a by clause but WITHOUT a using clause + +{-# OPTIONS_GHC -XTransformListComp #-} + +module Main where + +import GHC.Exts(the) + +main = putStrLn (show output) + where + output = [ (the dept, sum salary, name) + | (dept, salary, name) <- [("A", 1, "Bob"), ("B", 2, "Fred"), ("A", 5, "Jim"), ("A", 9, "Jim")] + , then group by dept ]
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun017.stdout b/testsuite/tests/deSugar/should_run/dsrun017.stdout new file mode 100644 index 0000000000..60ddd472ac --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun017.stdout @@ -0,0 +1 @@ +[("A",15,["Bob","Jim","Jim"]),("B",2,["Fred"])] diff --git a/testsuite/tests/deSugar/should_run/dsrun018.hs b/testsuite/tests/deSugar/should_run/dsrun018.hs new file mode 100644 index 0000000000..d89f5b24f3 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun018.hs @@ -0,0 +1,18 @@ +-- Test grouping with both a using and a by clause + +{-# OPTIONS_GHC -XTransformListComp #-} + +module Main where + +import Data.List(groupBy) +import GHC.Exts(the) + +groupRuns :: Eq b => (a -> b) -> [a] -> [[a]] +groupRuns f = groupBy (\x y -> f x == f y) + +main = putStrLn (show output) + where + output = [ (the x, product y) + | x <- ([1, 1, 1, 2, 2, 1, 3]) + , y <- [4..6] + , then group by x using groupRuns ]
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun018.stdout b/testsuite/tests/deSugar/should_run/dsrun018.stdout new file mode 100644 index 0000000000..7c2936211d --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun018.stdout @@ -0,0 +1 @@ +[(1,1728000),(2,14400),(1,120),(3,120)] diff --git a/testsuite/tests/deSugar/should_run/dsrun019.hs b/testsuite/tests/deSugar/should_run/dsrun019.hs new file mode 100644 index 0000000000..049d264114 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun019.hs @@ -0,0 +1,11 @@ +-- Test transform WITHOUT a by clause + +{-# OPTIONS_GHC -XTransformListComp #-} + +module Main where + +main = putStrLn (show output) + where + output = [ x + | x <- [1..10] + , then take 5 ]
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun019.stdout b/testsuite/tests/deSugar/should_run/dsrun019.stdout new file mode 100644 index 0000000000..bfedf5b35e --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun019.stdout @@ -0,0 +1 @@ +[1,2,3,4,5] diff --git a/testsuite/tests/deSugar/should_run/dsrun020.hs b/testsuite/tests/deSugar/should_run/dsrun020.hs new file mode 100644 index 0000000000..6d26dc5607 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun020.hs @@ -0,0 +1,14 @@ +-- Tests transform WITH a by clause + +{-# OPTIONS_GHC -XTransformListComp #-} + +module Main where + +import Data.List(takeWhile) + +main = putStrLn (show output) + where + output = [ (x * 10) + y + | x <- [1..4] + , y <- [1..4] + , then takeWhile by (x + y) < 4]
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun020.stdout b/testsuite/tests/deSugar/should_run/dsrun020.stdout new file mode 100644 index 0000000000..771f5460d8 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun020.stdout @@ -0,0 +1 @@ +[11,12] diff --git a/testsuite/tests/deSugar/should_run/dsrun021.hs b/testsuite/tests/deSugar/should_run/dsrun021.hs new file mode 100644 index 0000000000..7489f77a4a --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun021.hs @@ -0,0 +1,22 @@ +-- Transformation stress test
+
+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Main where
+
+import Data.List(takeWhile)
+import GHC.Exts(sortWith)
+
+employees = [ ("Simon", "MS", 80)
+ , ("Erik", "MS", 100)
+ , ("Phil", "Ed", 40)
+ , ("Gordon", "Ed", 45)
+ , ("Paul", "Yale", 60)]
+
+main = putStrLn (show output)
+ where
+ output = [ (dept, salary)
+ | (name, dept, salary) <- employees
+ , then sortWith by salary
+ , then filter by salary > 50
+ , then take 1 ]
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun021.stdout b/testsuite/tests/deSugar/should_run/dsrun021.stdout new file mode 100644 index 0000000000..b7de0302ef --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun021.stdout @@ -0,0 +1 @@ +[("Yale",60)] diff --git a/testsuite/tests/deSugar/should_run/dsrun022.hs b/testsuite/tests/deSugar/should_run/dsrun022.hs new file mode 100644 index 0000000000..dbbd906ce8 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun022.hs @@ -0,0 +1,26 @@ +-- Transformation and grouping stress test + +{-# OPTIONS_GHC -XTransformListComp #-} + +module Main where + +import GHC.Exts(sortWith, the) + +employees = [ ("Simon", "MS", 80) + , ("Erik", "MS", 100) + , ("Phil", "Ed", 40) + , ("Gordon", "Ed", 45) + , ("Paul", "Yale", 60) ] + +main = putStrLn (show can_still_use_group_function) >> putStrLn (show output) + where + output = [ (the dept, map sum salary, (show x) ++ " and " ++ (show y)) + | (name, dept, salary) <- employees + , then group by dept + , x <- [1, 2, 3] + , y <- [4, 5, 6] + , then sortWith by sum salary + , then take 4 + , then group using replicate 2 ] + group = const "my group function called!" + can_still_use_group_function = group "Mississippi"
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun022.stdout b/testsuite/tests/deSugar/should_run/dsrun022.stdout new file mode 100644 index 0000000000..c426e190ce --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun022.stdout @@ -0,0 +1,2 @@ +"my group function called!" +[(["Yale"],[60,60,60,60],"[1,1,1,2] and [4,5,6,4]"),(["Yale"],[60,60,60,60],"[1,1,1,2] and [4,5,6,4]")] diff --git a/testsuite/tests/deSugar/should_run/dsrun023.hs b/testsuite/tests/deSugar/should_run/dsrun023.hs new file mode 100644 index 0000000000..8189633415 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun023.hs @@ -0,0 +1,41 @@ +-- "Big tuple" stress test for parallel and transform comprehensions + +{-# OPTIONS_GHC -XTransformListComp -XParallelListComp #-} + +module Main where + +main = putStrLn (show output) + where + output = [ x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + + x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + + x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 + + x40 + x41 + x42 + x43 + x44 + x45 + x46 + x47 + x48 + x49 + + x50 + x51 + x52 + x53 + x54 + x55 + x56 + x57 + x58 + x59 + + x60 + x61 + x62 + x63 + x64 + x65 + x66 + x67 + x68 + x69 + + x70 + x71 + x72 + x73 + x74 + x75 + x76 + x77 + x78 + x79 + + x80 + x81 + x82 + x83 + x84 + x85 + x86 + x87 + x88 + x89 + + x90 + x91 + x92 + x93 + x94 + x95 + x96 + x97 + x98 + x99 + + y + | x0 <- [0], x1 <- [1], x2 <- [2], x3 <- [3], x4 <- [4] + , x5 <- [5], x6 <- [6], x7 <- [7], x8 <- [8], x9 <- [9] + , x10 <- [0], x11 <- [1], x12 <- [2], x13 <- [3], x14 <- [4] + , x15 <- [5], x16 <- [6], x17 <- [7], x18 <- [8], x19 <- [9] + , x20 <- [0], x21 <- [1], x22 <- [2], x23 <- [3], x24 <- [4] + , x25 <- [5], x26 <- [6], x27 <- [7], x28 <- [8], x29 <- [9] + , x30 <- [0], x31 <- [1], x32 <- [2], x33 <- [3], x34 <- [4] + , x35 <- [5], x36 <- [6], x37 <- [7], x38 <- [8], x39 <- [9] + , x40 <- [0], x41 <- [1], x42 <- [2], x43 <- [3], x44 <- [4] + , x45 <- [5], x46 <- [6], x47 <- [7], x48 <- [8], x49 <- [9] + , x50 <- [0], x51 <- [1], x52 <- [2], x53 <- [3], x54 <- [4] + , x55 <- [5], x56 <- [6], x57 <- [7], x58 <- [8], x59 <- [9] + , x60 <- [0], x61 <- [1], x62 <- [2], x63 <- [3], x64 <- [4] + , x65 <- [5], x66 <- [6], x67 <- [7], x68 <- [8], x69 <- [9] + , x70 <- [0], x71 <- [1], x72 <- [2], x73 <- [3], x74 <- [4] + , x75 <- [5], x76 <- [6], x77 <- [7], x78 <- [8], x79 <- [9] + , x80 <- [0], x81 <- [1], x82 <- [2], x83 <- [3], x84 <- [4] + , x85 <- [5], x86 <- [6], x87 <- [7], x88 <- [8], x89 <- [9] + , x90 <- [0], x91 <- [1], x92 <- [2], x93 <- [3], x94 <- [4] + , x95 <- [5], x96 <- [6], x97 <- [7], x98 <- [8], x99 <- [9] + , then take 4 + | y <- [10] ]
\ No newline at end of file diff --git a/testsuite/tests/deSugar/should_run/dsrun023.stdout b/testsuite/tests/deSugar/should_run/dsrun023.stdout new file mode 100644 index 0000000000..538ca9d5f0 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/dsrun023.stdout @@ -0,0 +1 @@ +[460] diff --git a/testsuite/tests/deSugar/should_run/mc01.hs b/testsuite/tests/deSugar/should_run/mc01.hs new file mode 100644 index 0000000000..cf5ca1a0e9 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc01.hs @@ -0,0 +1,26 @@ +-- Transformation and grouping stress test + +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} + +module Main where + +import GHC.Exts(sortWith, the) + +employees = [ ("Simon", "MS", 80) + , ("Erik", "MS", 100) + , ("Phil", "Ed", 40) + , ("Gordon", "Ed", 45) + , ("Paul", "Yale", 60) ] + +main = putStrLn (show can_still_use_group_function) >> putStrLn (show output) + where + output = [ (the dept, map sum salary, (show x) ++ " and " ++ (show y)) + | (name, dept, salary) <- employees + , then group by dept + , x <- [1, 2, 3] + , y <- [4, 5, 6] + , then sortWith by sum salary + , then take 4 + , then group using replicate 2 ] + group = const "my group function called!" + can_still_use_group_function = group "Mississippi" diff --git a/testsuite/tests/deSugar/should_run/mc01.stdout b/testsuite/tests/deSugar/should_run/mc01.stdout new file mode 100644 index 0000000000..c426e190ce --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc01.stdout @@ -0,0 +1,2 @@ +"my group function called!" +[(["Yale"],[60,60,60,60],"[1,1,1,2] and [4,5,6,4]"),(["Yale"],[60,60,60,60],"[1,1,1,2] and [4,5,6,4]")] diff --git a/testsuite/tests/deSugar/should_run/mc02.hs b/testsuite/tests/deSugar/should_run/mc02.hs new file mode 100644 index 0000000000..77adf26c37 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc02.hs @@ -0,0 +1,22 @@ +-- Transformation stress test + +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} + +module Main where + +import Data.List(takeWhile) +import GHC.Exts(sortWith) + +employees = [ ("Simon", "MS", 80) + , ("Erik", "MS", 100) + , ("Phil", "Ed", 40) + , ("Gordon", "Ed", 45) + , ("Paul", "Yale", 60)] + +main = putStrLn (show output) + where + output = [ (dept, salary) + | (name, dept, salary) <- employees + , then sortWith by salary + , then filter by salary > 50 + , then take 1 ] diff --git a/testsuite/tests/deSugar/should_run/mc02.stdout b/testsuite/tests/deSugar/should_run/mc02.stdout new file mode 100644 index 0000000000..b7de0302ef --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc02.stdout @@ -0,0 +1 @@ +[("Yale",60)] diff --git a/testsuite/tests/deSugar/should_run/mc03.hs b/testsuite/tests/deSugar/should_run/mc03.hs new file mode 100644 index 0000000000..1b52c83c46 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc03.hs @@ -0,0 +1,41 @@ +-- "Big tuple" stress test for monad comprehensions + +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp -XParallelListComp #-} + +module Main where + +main = putStrLn (show output) + where + output = [ x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + + x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + + x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 + + x40 + x41 + x42 + x43 + x44 + x45 + x46 + x47 + x48 + x49 + + x50 + x51 + x52 + x53 + x54 + x55 + x56 + x57 + x58 + x59 + + x60 + x61 + x62 + x63 + x64 + x65 + x66 + x67 + x68 + x69 + + x70 + x71 + x72 + x73 + x74 + x75 + x76 + x77 + x78 + x79 + + x80 + x81 + x82 + x83 + x84 + x85 + x86 + x87 + x88 + x89 + + x90 + x91 + x92 + x93 + x94 + x95 + x96 + x97 + x98 + x99 + + y + | x0 <- [0], x1 <- [1], x2 <- [2], x3 <- [3], x4 <- [4] + , x5 <- [5], x6 <- [6], x7 <- [7], x8 <- [8], x9 <- [9] + , x10 <- [0], x11 <- [1], x12 <- [2], x13 <- [3], x14 <- [4] + , x15 <- [5], x16 <- [6], x17 <- [7], x18 <- [8], x19 <- [9] + , x20 <- [0], x21 <- [1], x22 <- [2], x23 <- [3], x24 <- [4] + , x25 <- [5], x26 <- [6], x27 <- [7], x28 <- [8], x29 <- [9] + , x30 <- [0], x31 <- [1], x32 <- [2], x33 <- [3], x34 <- [4] + , x35 <- [5], x36 <- [6], x37 <- [7], x38 <- [8], x39 <- [9] + , x40 <- [0], x41 <- [1], x42 <- [2], x43 <- [3], x44 <- [4] + , x45 <- [5], x46 <- [6], x47 <- [7], x48 <- [8], x49 <- [9] + , x50 <- [0], x51 <- [1], x52 <- [2], x53 <- [3], x54 <- [4] + , x55 <- [5], x56 <- [6], x57 <- [7], x58 <- [8], x59 <- [9] + , x60 <- [0], x61 <- [1], x62 <- [2], x63 <- [3], x64 <- [4] + , x65 <- [5], x66 <- [6], x67 <- [7], x68 <- [8], x69 <- [9] + , x70 <- [0], x71 <- [1], x72 <- [2], x73 <- [3], x74 <- [4] + , x75 <- [5], x76 <- [6], x77 <- [7], x78 <- [8], x79 <- [9] + , x80 <- [0], x81 <- [1], x82 <- [2], x83 <- [3], x84 <- [4] + , x85 <- [5], x86 <- [6], x87 <- [7], x88 <- [8], x89 <- [9] + , x90 <- [0], x91 <- [1], x92 <- [2], x93 <- [3], x94 <- [4] + , x95 <- [5], x96 <- [6], x97 <- [7], x98 <- [8], x99 <- [9] + , then take 4 + | y <- [10] ] diff --git a/testsuite/tests/deSugar/should_run/mc03.stdout b/testsuite/tests/deSugar/should_run/mc03.stdout new file mode 100644 index 0000000000..538ca9d5f0 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc03.stdout @@ -0,0 +1 @@ +[460] diff --git a/testsuite/tests/deSugar/should_run/mc04.hs b/testsuite/tests/deSugar/should_run/mc04.hs new file mode 100644 index 0000000000..38747a46e3 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc04.hs @@ -0,0 +1,14 @@ +-- Tests grouping WITH a using clause but WITHOUT a by clause + +{-# OPTIONS_GHC -XTransformListComp #-} + +module Main where + +import Data.List(inits) + +main = putStrLn (show output) + where + output = [ x + | y <- [1..3] + , x <- "hello" + , then group using inits ] diff --git a/testsuite/tests/deSugar/should_run/mc04.stdout b/testsuite/tests/deSugar/should_run/mc04.stdout new file mode 100644 index 0000000000..60b1b8058e --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc04.stdout @@ -0,0 +1 @@ +["","h","he","hel","hell","hello","helloh","hellohe","hellohel","hellohell","hellohello","hellohelloh","hellohellohe","hellohellohel","hellohellohell","hellohellohello"] diff --git a/testsuite/tests/deSugar/should_run/mc05.hs b/testsuite/tests/deSugar/should_run/mc05.hs new file mode 100644 index 0000000000..c2d7d2d4a5 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc05.hs @@ -0,0 +1,11 @@ +-- Test transform WITHOUT a by clause + +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} + +module Main where + +main = putStrLn (show output) + where + output = [ x + | x <- [1..10] + , then take 5 ] diff --git a/testsuite/tests/deSugar/should_run/mc05.stdout b/testsuite/tests/deSugar/should_run/mc05.stdout new file mode 100644 index 0000000000..bfedf5b35e --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc05.stdout @@ -0,0 +1 @@ +[1,2,3,4,5] diff --git a/testsuite/tests/deSugar/should_run/mc06.hs b/testsuite/tests/deSugar/should_run/mc06.hs new file mode 100644 index 0000000000..20fe041283 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc06.hs @@ -0,0 +1,18 @@ +-- Test grouping with both a using and a by clause + +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} + +module Main where + +import Data.List(groupBy) +import GHC.Exts(the) + +groupRuns :: Eq b => (a -> b) -> [a] -> [[a]] +groupRuns f = groupBy (\x y -> f x == f y) + +main = putStrLn (show output) + where + output = [ (the x, product y) + | x <- ([1, 1, 1, 2, 2, 1, 3]) + , y <- [4..6] + , then group by x using groupRuns ] diff --git a/testsuite/tests/deSugar/should_run/mc06.stdout b/testsuite/tests/deSugar/should_run/mc06.stdout new file mode 100644 index 0000000000..7c2936211d --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc06.stdout @@ -0,0 +1 @@ +[(1,1728000),(2,14400),(1,120),(3,120)] diff --git a/testsuite/tests/deSugar/should_run/mc07.hs b/testsuite/tests/deSugar/should_run/mc07.hs new file mode 100644 index 0000000000..7726dedb65 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc07.hs @@ -0,0 +1,14 @@ +-- Tests transform WITH a by clause + +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} + +module Main where + +import Data.List(takeWhile) + +main = putStrLn (show output) + where + output = [ (x * 10) + y + | x <- [1..4] + , y <- [1..4] + , then takeWhile by (x + y) < 4] diff --git a/testsuite/tests/deSugar/should_run/mc07.stdout b/testsuite/tests/deSugar/should_run/mc07.stdout new file mode 100644 index 0000000000..771f5460d8 --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc07.stdout @@ -0,0 +1 @@ +[11,12] diff --git a/testsuite/tests/deSugar/should_run/mc08.hs b/testsuite/tests/deSugar/should_run/mc08.hs new file mode 100644 index 0000000000..24dd3beb4c --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc08.hs @@ -0,0 +1,13 @@ +-- Tests grouping WITH a by clause but WITHOUT a using clause + +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} + +module Main where + +import GHC.Exts(the) + +main = putStrLn (show output) + where + output = [ (the dept, sum salary, name) + | (dept, salary, name) <- [("A", 1, "Bob"), ("B", 2, "Fred"), ("A", 5, "Jim"), ("A", 9, "Jim")] + , then group by dept ] diff --git a/testsuite/tests/deSugar/should_run/mc08.stdout b/testsuite/tests/deSugar/should_run/mc08.stdout new file mode 100644 index 0000000000..60ddd472ac --- /dev/null +++ b/testsuite/tests/deSugar/should_run/mc08.stdout @@ -0,0 +1 @@ +[("A",15,["Bob","Jim","Jim"]),("B",2,["Fred"])] |