Commit 33b21f55 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Tests for generalised list comprehensions

parent acd47305
# Boring file regexps:
\.hi$
\.hi-boot$
_hi$
\.o$
\.o-boot$
_o$
\.p_hi$
\.p_o$
\.a$
......@@ -29,6 +33,7 @@
(^|/)BitKeeper($|/)
(^|/)ChangeSet($|/)
(^|/)\.svn($|/)
(^|/)\.hpc($|/)
\.py[co]$
\#
\.cvsignore$
......@@ -42,5 +47,11 @@
\.out[12]$
\.inout$
\.hc$
\.exe\.manifest$
\.exe$
\.tix$
\.genscript$
\.comp.std[a-z]+$
\.normalised$
[0-9][0-9][0-9]$
_stub.[hc]$
......@@ -18,3 +18,11 @@ 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', expect_broken(1491), 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, [''])
-- Tests grouping WITH a using clause but WITHOUT a by clause
{-# OPTIONS_GHC -XTransformListComp #-}
module Main where
import List(inits)
main = putStrLn (show output)
where
output = [ x
| y <- [1..3]
, x <- "hello"
, then group using inits ]
["","h","he","hel","hell","hello","helloh","hellohe","hellohel","hellohell","hellohello","hellohelloh","hellohellohe","hellohellohel","hellohellohell","hellohellohello"]
-- 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
[("A",15,["Bob","Jim","Jim"]),("B",2,["Fred"])]
-- Test grouping with both a using and a by clause
{-# OPTIONS_GHC -XTransformListComp #-}
module Main where
import 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
-- 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
-- Tests transform WITH a by clause
{-# OPTIONS_GHC -XTransformListComp #-}
module Main where
import 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
-- Transformation stress test
{-# OPTIONS_GHC -XTransformListComp #-}
module Main where
import 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)
| then sortWith by 1
, (name, dept, salary) <- employees
, then sortWith by salary
, then filter by salary > 50
, then take 1 ]
\ No newline at end of file
-- 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 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 ]
\ No newline at end of file
[(["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]")]
-- "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
......@@ -73,3 +73,4 @@ test('read058', normal, compile, [''])
test('read059', normal, compile, [''])
test('read060', normal, compile, [''])
test('read061', normal, compile, [''])
test('read062', normal, compile, [''])
{-# OPTIONS_GHC -XTransformListComp #-}
module Foo where
import List
import GHC.Exts
foo = [ ()
| x <- [1..10]
, then take 5
, then sortWith by x
, then group by x
, then group using inits
, then group by x using groupWith
]
......@@ -48,3 +48,5 @@ test('read038', normal, compile_fail, [''])
test('read039', normal, compile_fail, [''])
test('read040', normal, compile_fail, [''])
test('read041', normal, compile_fail, [''])
test('read042', normal, compile_fail, [''])
test('read043', normal, compile_fail, [''])
-- Check error message for transforms if we don't have the right extension turned on
module Foo where
import List
import GHC.Exts
foo = [ ()
| x <- [1..10]
, then take 5
, then sortWith by x
]
\ No newline at end of file
read042.hs:8:6:
Illegal transform or grouping list comprehension: use -XTransformListComp
read042.hs:8:6:
Illegal transform or grouping list comprehension: use -XTransformListComp
read042.hs:11:22: Not in scope: `by'
read042.hs:11:25: Not in scope: `x'
-- Check error message for groups if we don't have the right extension turned on
module Foo where
import List
import GHC.Exts
foo = [ ()
| x <- [1..10]
, then group by x
, then group by x using groupWith
, then group using inits
]
read043.hs:8:6:
Illegal transform or grouping list comprehension: use -XTransformListComp
read043.hs:8:6:
Illegal transform or grouping list comprehension: use -XTransformListComp
read043.hs:8:6:
Illegal transform or grouping list comprehension: use -XTransformListComp
read043.hs:10:19: Not in scope: `by'
read043.hs:10:22: Not in scope: `x'
read043.hs:11:19: Not in scope: `by'
read043.hs:11:22: Not in scope: `x'
read043.hs:11:24: Not in scope: `using'
read043.hs:12:19: Not in scope: `using'
......@@ -50,3 +50,5 @@ test('rnfail045', normal, compile_fail, [''])
test('rnfail046', normal, compile_fail, [''])
test('rnfail047', normal, multimod_compile_fail, ['rnfail047', '-v0'])
test('rnfail048', normal, compile_fail, [''])
test('rnfail049', normal, compile_fail, [''])
test('rnfail050', normal, compile_fail, [''])
-- Test trying to use a function bound in the list comprehension as the group function
{-# OPTIONS_GHC -XRank2Types -XTransformListComp #-}
module RnFail049 where
import List(inits, tails)
functions :: [forall a. [a] -> [[a]]]
functions = [inits, tails]
output = [() | f <- functions, then group using f]
-- Test trying to use a function bound in the list comprehension as the transform function
{-# OPTIONS_GHC -XRank2Types -XTransformListComp #-}
module RnFail048 where
functions :: [forall a. [a] -> [a]]
functions = [take 4, take 5]
output = [() | f <- functions, then f]
......@@ -254,6 +254,8 @@ test('tc238', normal, compile, [''])
test('tc239', extra_clean(['Tc239_Help.hi', 'Tc239_Help.o']),
multimod_compile, ['tc239', '-v0'])
test('tc240', normal, compile, [''])
test('FD1', normal, compile_fail, [''])
test('FD2', normal, compile_fail, [''])
......
-- Checks that the types of the old binder and the binder implicitly introduced by grouping are linked
{-# OPTIONS_GHC -XTransformListComp #-}
module ShouldCompile where
import List(inits)
foo :: [[[Int]]]
foo = [ x
| x <- [1..10]
, then group using inits
, then group using inits
]
\ No newline at end of file
......@@ -177,3 +177,9 @@ test('tcfail186',
multimod_compile_fail, ['tcfail186', '-v0'])
test('tcfail187', if_compiler_lt('ghc','6.9', namebase('tcfail187-6.8')), compile_fail, [''])
test('tcfail188', normal, compile_fail, [''])
test('tcfail189', normal, compile_fail, [''])
test('tcfail190', normal, compile_fail, [''])
test('tcfail191', normal, compile_fail, [''])
test('tcfail192', normal, compile_fail, [''])
test('tcfail193', normal, compile_fail, [''])
test('tcfail194', normal, compile_fail, [''])
\ No newline at end of file
-- Checks that the correct type is used checking the using clause of the group when a by clause is present
{-# OPTIONS_GHC -XTransformListComp #-}
module ShouldFail where
foo = [ ()
| x <- [1..10]
, then group by x using take 2
]
tcfail189.hs:9:30:
Couldn't match expected type `a -> t' against inferred type `[a1]'
In the expression: take 2
In a list comprehension:
x <- [1 .. 10] then group by x using take 2
In the expression:
[() | x <- [1 .. 10] then group by x using take 2]
-- Checks that the ordering constraint on the implicit groupWith is respected
{-# OPTIONS_GHC -XTransformListComp #-}
module ShouldFail where
data Unorderable = Gnorf | Pinky | Brain
foo = [ ()
| x <- [Gnorf, Brain]
, then group by x
]
tcfail190.hs:11:8:
No instance for (Ord Unorderable)
arising from a use of `GHC.Exts.groupWith' at tcfail190.hs:11:8
Possible fix: add an instance declaration for (Ord Unorderable)
In the expression: GHC.Exts.groupWith
In a list comprehension: x <- [Gnorf, Brain] then group by x
In the expression: [() | x <- [Gnorf, Brain] then group by x]
-- Checks that the correct type is used checking the using clause of the group
{-# OPTIONS_GHC -XTransformListComp #-}
module ShouldFail where
data Unorderable = Gnorf | Pinky | Brain
foo = [ ()
| x <- [Gnorf, Brain]
, then group using take 5
]
tcfail191.hs:10:8:
Occurs check: cannot construct the infinite type: a = [a]
In the expression: take 5
In a list comprehension:
x <- [Gnorf, Brain] then group using take 5
In the expression:
[() | x <- [Gnorf, Brain] then group using take 5]
-- Checks that the types of the old binder and the binder implicitly introduced by grouping are linked
{-# OPTIONS_GHC -XTransformListComp #-}
module ShouldFail where
foo = [ x + 1
| x <- ["Hello", "World"]
, then group using take 5
]
\ No newline at end of file
tcfail192.hs:8:8:
Occurs check: cannot construct the infinite type: a = [a]
In the expression: take 5
In a list comprehension:
x <- ["Hello", "World"] then group using take 5
In the expression:
[x + 1 | x <- ["Hello", "World"] then group using take 5]
-- Checks that the correct type is used checking the using clause of the transform
{-# OPTIONS_GHC -XTransformListComp #-}
module ShouldFail where
import List(inits)
z :: [Int]
z = [x | x <- [3, 2, 1], then inits]
tcfail193.hs:10:9:
Occurs check: cannot construct the infinite type: a = [a]
In the expression: inits
In a list comprehension: x <- [3, 2, 1] then inits
In the expression: [x | x <- [3, 2, 1] then inits]
-- Checks that using the "by" clause in a transform requires a function parameter
{-# OPTIONS_GHC -XTransformListComp #-}
module ShouldFail where
import List(take)
z = [x | x <- [1..10], then take 5 by x]
tcfail194.hs:9:28:
Couldn't match expected type `a -> t' against inferred type `[a1]'
In the expression: take 5
In a list comprehension: x <- [1 .. 10] then take 5 by x
In the expression: [x | x <- [1 .. 10] then take 5 by x]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment