DSH-0.10.0.0: tests/ComprehensionTests.hs
module ComprehensionTests where
import Common
import qualified DSHComprehensions as C
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.HUnit (Assertion)
import Test.QuickCheck
tests_comprehensions :: Test
tests_comprehensions = testGroup "Comprehensions"
[ testProperty "cartprod" prop_cartprod
, testProperty "eqjoin" prop_eqjoin
, testProperty "eqjoinproj" prop_eqjoinproj
, testProperty "eqjoinpred" prop_eqjoinpred
, testProperty "eqjointuples" prop_eqjointuples
, testProperty "thetajoin_eq" prop_thetajoin_eq
, testProperty "thetajoin_neq" prop_thetajoin_neq
, testProperty "eqjoin3" prop_eqjoin3
, testProperty "eqjoin_nested_left" prop_eqjoin_nested_left
, testProperty "eqjoin_nested_right" prop_eqjoin_nested_right
, testProperty "eqjoin_nested_both" prop_eqjoin_nested_both
, testProperty "nestjoin" prop_nestjoin
, testProperty "nestjoin3" prop_nestjoin3
, testProperty "antijoin class12" prop_aj_class12
, testProperty "antijoin class15" prop_aj_class15
, testProperty "antijoin class16" prop_aj_class16
, testProperty "backdep1" prop_backdep
, testProperty "backdep_filter" prop_backdep_filter
, testProperty "backdep2" prop_backdep2
, testProperty "backdep3" prop_backdep3
, testProperty "backdep4" prop_backdep4
, testProperty "backdep5" prop_backdep5
, testProperty "deep" prop_deep_iter
]
tests_join_hunit :: Test
tests_join_hunit = testGroup "HUnit joins"
[ testCase "heqjoin_nested1" heqjoin_nested1
, testCase "hsemijoin" hsemijoin
, testCase "hsemijoin_range" hsemijoin_range
, testCase "hsemijoin_quant" hsemijoin_quant
, testCase "hsemijoin_not_null" hsemijoin_not_null
, testCase "hantijoin" hantijoin
, testCase "hantijoin_range" hantijoin_range
, testCase "hantijoin_null" hantijoin_null
, testCase "hantijoin_class12" hantijoin_class12
, testCase "hantijoin_class15" hantijoin_class15
, testCase "hantijoin_class16" hantijoin_class16
, testCase "hfrontguard" hfrontguard
]
tests_nest_head_hunit :: Test
tests_nest_head_hunit = testGroup "HUnit head nesting"
[ testCase "hnj1" hnj1
, testCase "hnj2" hnj2
, testCase "hnj3" hnj3
, testCase "hnj4" hnj4
, testCase "hnj5" hnj5
, testCase "hnj6" hnj6
, testCase "hnj7" hnj7
, testCase "hnj8" hnj8
, testCase "hnj9" hnj9
, testCase "hnj10" hnj10
, testCase "hnj11" hnj11
, testCase "hnj12" hnj12
, testCase "hnp1" hnp1
, testCase "hnp2" hnp2
, testCase "hnp3" hnp3
, testCase "hnp4" hnp4
]
tests_nest_guard_hunit :: Test
tests_nest_guard_hunit = testGroup "HUnit guard nesting"
[ testCase "hnjg1" hnjg1
, testCase "hnjg2" hnjg2
, testCase "hnjg3" hnjg3
, testCase "hnjg4" hnjg4
, testCase "hnjg5" hnjg5
]
---------------------------------------------------------------------------------
-- QuickCheck properties for comprehensions
prop_cartprod :: ([Integer], [Integer]) -> Property
prop_cartprod = makeProp C.cartprod cartprod_native
where
cartprod_native (xs, ys) = [ (x, y) | x <- xs, y <- ys]
prop_eqjoin :: ([Integer], [Integer]) -> Property
prop_eqjoin = makeProp C.eqjoin eqjoin_native
where
eqjoin_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , x == y ]
prop_eqjoinproj :: ([Integer], [Integer]) -> Property
prop_eqjoinproj = makeProp C.eqjoinproj eqjoinproj_native
where
eqjoinproj_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , (2 * x) == y ]
prop_eqjoinpred :: (Integer, [Integer], [Integer]) -> Property
prop_eqjoinpred = makeProp C.eqjoinpred eqjoinpred_native
where
eqjoinpred_native (x', xs, ys) = [ (x, y) | x <- xs , y <- ys , x == y , x > x']
prop_eqjointuples :: ([(Integer, Integer)], [(Integer, Integer)]) -> Property
prop_eqjointuples = makeProp C.eqjointuples eqjointuples_native
where
eqjointuples_native (xs, ys) = [ (x1 * x2, y1, y2)
| (x1, x2) <- xs
, (y1, y2) <- ys
, x1 == y2
]
prop_thetajoin_eq :: ([(Integer, Integer)], [(Integer, Integer)]) -> Property
prop_thetajoin_eq = makeProp C.thetajoin_eq thetajoin_eq_native
where
thetajoin_eq_native (xs, ys) = [ (x1 * x2, y1, y2)
| (x1, x2) <- xs
, (y1, y2) <- ys
, x1 == y2
, y1 == x2
]
prop_thetajoin_neq :: ([(Integer, Integer)], [(Integer, Integer)]) -> Property
prop_thetajoin_neq = makeProp C.thetajoin_neq thetajoin_neq_native
where
thetajoin_neq_native (xs, ys) = [ (x1 * x2, y1, y2)
| (x1, x2) <- xs
, (y1, y2) <- ys
, x1 == y2
, y1 /= x2
]
prop_eqjoin3 :: ([Integer], [Integer], [Integer]) -> Property
prop_eqjoin3 = makeProp C.eqjoin3 eqjoin3_native
where
eqjoin3_native (xs, ys, zs) = [ (x, y, z) | x <- xs , y <- ys , z <- zs , x == y , y == z]
prop_eqjoin_nested_left :: ([(Integer, [Integer])], [Integer]) -> Property
prop_eqjoin_nested_left = makeProp C.eqjoin_nested_left eqjoin_nested_left_native
where
eqjoin_nested_left_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , fst x == y]
prop_eqjoin_nested_right :: ([Integer], [(Integer, [Integer])]) -> Property
prop_eqjoin_nested_right = makeProp C.eqjoin_nested_right eqjoin_nested_right_native
where
eqjoin_nested_right_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , x == fst y]
prop_eqjoin_nested_both :: ([(Integer, [Integer])], [(Integer, [Integer])]) -> Property
prop_eqjoin_nested_both = makeProp C.eqjoin_nested_both eqjoin_nested_both_native
where
eqjoin_nested_both_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , fst x == fst y]
prop_nestjoin :: ([Integer], [Integer]) -> Property
prop_nestjoin = makeProp C.nestjoin nestjoin_native
where
nestjoin_native (xs, ys) = [ (x, [ y | y <- ys, x == y ]) | x <- xs]
prop_nestjoin3 :: ([Integer], [Integer], [Integer]) -> Property
prop_nestjoin3 = makeProp C.nestjoin3 nestjoin3_native
where
nestjoin3_native (njxs, njys, njzs) =
[ [ [ (x,y,z) | z <- njzs, y == z ]
| y <- njys
, x == y
]
| x <- njxs
]
prop_aj_class12 :: ([Integer], [Integer]) -> Property
prop_aj_class12 = makeProp C.aj_class12 aj_class12_native
where
aj_class12_native (ajxs, ajys) = [ x
| x <- ajxs
, and [ x == y | y <- ajys, y > 10 ]
]
prop_aj_class15 :: ([Integer], [Integer]) -> Property
prop_aj_class15 = makeProp C.aj_class15 aj_class15_native
where
aj_class15_native (ajxs, ajys) = [ x
| x <- ajxs
, and [ y `mod` 4 == 0 | y <- ajys, x < y ]
]
prop_aj_class16 :: ([Integer], [Integer]) -> Property
prop_aj_class16 = makeProp C.aj_class16 aj_class16_native
where
aj_class16_native (ajxs, ajys) = [ x
| x <- ajxs
, and [ y <= 2 * x | y <- ajys, x < y ]
]
prop_backdep :: [[Integer]] -> Property
prop_backdep = makeProp C.backdep backdep_native
where
backdep_native xss = [x | xs <- xss, x <- xs]
prop_backdep_filter :: [[Integer]] -> Property
prop_backdep_filter = makeProp C.backdep_filter backdep_filter_native
where
backdep_filter_native xss = [x | xs <- xss, x <- xs, fromIntegral (length xs) > x]
prop_backdep2 :: [[Integer]] -> Property
prop_backdep2 = makeProp C.backdep2 backdep2
where
backdep2 xss = [ [ x * 42 | x <- xs ] | xs <- xss ]
prop_backdep3 :: [[Integer]] -> Property
prop_backdep3 = makeProp C.backdep3 backdep3
where
backdep3 xss = [ [ x + fromIntegral (length xs) | x <- xs ] | xs <- xss ]
prop_backdep4 :: [[[Integer]]] -> Property
prop_backdep4 = makeProp C.backdep4 backdep4
where
backdep4 xsss = [ [ [ x + fromIntegral (length xs) + fromIntegral (length xss)
| x <- xs
]
| xs <- xss
]
| xss <- xsss
]
prop_backdep5 :: [[Integer]] -> Property
prop_backdep5 = makeProp C.backdep5 backdep5
where
backdep5 xss = [ [ x + fromIntegral (length xs)
| x <- take (length xs - 3) xs ]
| xs <- xss ]
-----------------------------------------------------------------------
-- HUnit tests for comprehensions
heqjoin_nested1 :: Assertion
heqjoin_nested1 = makeEqAssertion "heqjoin_nested" C.eqjoin_nested1 res
where
res = [ ((20, ['b']), 20)
, ((30, ['c', 'd']), 30)
, ((30, ['c', 'd']), 30)
, ((40, []), 40)
]
hsemijoin :: Assertion
hsemijoin = makeEqAssertion "hsemijoin" C.semijoin res
where
res = [2, 4, 6, 7]
hsemijoin_range :: Assertion
hsemijoin_range = makeEqAssertion "hsemijoin_range" C.semijoin_range res
where
res = [2, 4]
hsemijoin_not_null :: Assertion
hsemijoin_not_null = makeEqAssertion "hsemijoin_range" C.semijoin_not_null res
where
res = [2, 4, 6, 7]
hsemijoin_quant :: Assertion
hsemijoin_quant = makeEqAssertion "hsemijoin_quant" C.semijoin_quant res
where
res = [6,7]
hantijoin :: Assertion
hantijoin = makeEqAssertion "hantijoin" C.antijoin res
where
res = [1, 3, 5]
hantijoin_range :: Assertion
hantijoin_range = makeEqAssertion "hantijoin_range" C.antijoin_range res
where
res = [1, 3, 5, 6, 7]
hantijoin_null :: Assertion
hantijoin_null = makeEqAssertion "hantijoin_range" C.antijoin_null res
where
res = [1, 3, 5]
hantijoin_class12 :: Assertion
hantijoin_class12 = makeEqAssertion "hantijoin_class12" C.antijoin_class12 res
where
res = [6,7,8,9,10]
hantijoin_class15 :: Assertion
hantijoin_class15 = makeEqAssertion "hantijoin_class15" C.antijoin_class15 res
where
res = [5,6,7,8]
hantijoin_class16 :: Assertion
hantijoin_class16 = makeEqAssertion "hantijoin_class16" C.antijoin_class16 res
where
res = [4,5,6]
hfrontguard :: Assertion
hfrontguard = makeEqAssertion "hfrontguard" C.frontguard res
where
res = [[],[1,2],[1,2]]
-----------------------------------------------------------------------
-- HUnit tests for nestjoin/nestproduct
njxs1 :: [Integer]
njxs1 = [1,2,3,4,5,6]
njys1 :: [Integer]
njys1 = [3,4,5,6,3,6,4,1,1,1]
hnj1 :: Assertion
hnj1 = makeEqAssertion "hnj1" (C.nj1 njxs1 njys1) (nj1 njxs1 njys1)
hnj2 :: Assertion
hnj2 = makeEqAssertion "hnj2" (C.nj2 njxs1 njys1) (nj2 njxs1 njys1)
hnj3 :: Assertion
hnj3 = makeEqAssertion "hnj3" (C.nj3 njxs1 njys1) (nj3 njxs1 njys1)
hnj4 :: Assertion
hnj4 = makeEqAssertion "hnj4" (C.nj4 njxs1 njys1) (nj4 njxs1 njys1)
hnj5 :: Assertion
hnj5 = makeEqAssertion "hnj5" (C.nj5 njxs1 njys1) (nj5 njxs1 njys1)
hnj6 :: Assertion
hnj6 = makeEqAssertion "hnj6" (C.nj6 njxs1 njys1) (nj6 njxs1 njys1)
hnj7 :: Assertion
hnj7 = makeEqAssertion "hnj7" (C.nj7 njxs1 njys1) (nj7 njxs1 njys1)
hnj8 :: Assertion
hnj8 = makeEqAssertion "hnj8" (C.nj8 njxs1 njys1) (nj8 njxs1 njys1)
hnj9 :: Assertion
hnj9 = makeEqAssertion "hnj9" (C.nj9 njxs1 njys1) (nj9 njxs1 njys1)
hnj10 :: Assertion
hnj10 = makeEqAssertion "hnj10" (C.nj10 njxs1 njys1) (nj10 njxs1 njys1)
hnj11 :: Assertion
hnj11 = makeEqAssertion "hnj11" (C.nj11 njxs1 njys1) (nj11 njxs1 njys1)
-- Test data for testcase hnj12
njxs2, njys2, njzs2 :: [Integer]
njxs2 = [1,2,3,4,5,5,2]
njys2 = [2,1,0,5,4,4,4]
njzs2 = [6,1,1,3,2,5]
hnj12 :: Assertion
hnj12 = makeEqAssertion "hnj12" (C.nj12 njxs2 njys2 njzs2) (nj12 njxs2 njys2 njzs2)
hnp1 :: Assertion
hnp1 = makeEqAssertion "hnp1" (C.np1 njxs1 njys1) (np1 njxs1 njys1)
hnp2 :: Assertion
hnp2 = makeEqAssertion "hnp2" (C.np2 njxs1 njys1) (np2 njxs1 njys1)
hnp3 :: Assertion
hnp3 = makeEqAssertion "hnp3" (C.np3 njxs1 njys1) (np3 njxs1 njys1)
hnp4 :: Assertion
hnp4 = makeEqAssertion "hnp4" (C.np4 njxs1 njys1) (np4 njxs1 njys1)
hnjg1 :: Assertion
hnjg1 = makeEqAssertion "hnjg1" (C.njg1 njgxs1 njgzs1) (njg1 njgxs1 njgzs1)
hnjg2 :: Assertion
hnjg2 = makeEqAssertion "hnjg2" (C.njg2 njgxs1 njgys1) (njg2 njgxs1 njgys1)
hnjg3 :: Assertion
hnjg3 = makeEqAssertion "hnjg3" (C.njg3 njgxs1 njgys1 njgzs1) (njg3 njgxs1 njgys1 njgzs1)
hnjg4 :: Assertion
hnjg4 = makeEqAssertion "hnjg4" (C.njg4 njgxs1 njgys1 njgzs1) (njg4 njgxs1 njgys1 njgzs1)
hnjg5 :: Assertion
hnjg5 = makeEqAssertion "hnjg5" (C.njg5 njgxs1 njgys1) (njg5 njgxs1 njgys1)
pair :: a -> b -> (a, b)
pair = (,)
-- Head/NestJoin
nj1 :: [Integer] -> [Integer] -> [[Integer]]
nj1 njxs njys =
[ [ y | y <- njys, x == y ]
| x <- njxs
]
nj2 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
nj2 njxs njys =
[ pair x [ y | y <- njys, x == y ]
| x <- njxs
]
nj3 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
nj3 njxs njys =
[ pair x ([ y | y <- njys, x == y ] ++ ([100, 200, 300]))
| x <- njxs
]
nj4 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
nj4 njxs njys =
[ pair x ([ y | y <- njys, x == y ] ++ [ z | z <- njys, x == z ])
| x <- njxs
]
nj5 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
nj5 njxs njys =
[ pair x [ y | y <- njys, x + y > 15 ]
| x <- njxs
]
nj6 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
nj6 njxs njys =
[ pair x [ y | y <- njys, x + y > 10, y < 7 ]
| x <- njxs
]
nj7 :: [Integer] -> [Integer] -> [[Integer]]
nj7 njxs njys =
[ [ x + y | y <- njys, x + 2 == y ] | x <- njxs ]
nj8 :: [Integer] -> [Integer] -> [[Integer]]
nj8 njxs njys = [ [ x + y | y <- njys, x == y, y < 5 ] | x <- njxs, x > 3 ]
nj9 :: [Integer] -> [Integer] -> [[Integer]]
nj9 njxs njys = [ [ x + y | y <- njys, x + 1 == y, y > 2, x < 6 ] | x <- njxs ]
nj10 :: [Integer] -> [Integer] -> [Integer]
nj10 njxs njys = [ x + sum [ x * y | y <- njys, x == y ] | x <- njxs ]
nj11 :: [Integer] -> [Integer] -> [[Integer]]
nj11 njxs njys = [ [ x + y | y <- njys, x > y, x < y * 2 ] | x <- njxs ]
nj12 :: [Integer] -> [Integer] -> [Integer] -> [[[(Integer, Integer, Integer)]]]
nj12 njxs njys njzs =
[ [ [ (x,y,z) | z <- njzs, y == z ]
| y <- njys
, x == y
]
| x <- njxs
]
-- Head/NestProduct
np1 :: [Integer] -> [Integer] -> [[Integer]]
np1 njxs njys = [ [ x * y * 2 | y <- njys ] | x <- njxs ]
np2 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
np2 njxs njys = [ pair x [ y * 2 | y <- njys ] | x <- njxs ]
np3 :: [Integer] -> [Integer] -> [[Integer]]
np3 njxs njys = [ [ x + y | y <- njys ] | x <- njxs ]
np4 :: [Integer] -> [Integer] -> [[Integer]]
np4 njxs njys = [ [ y | y <- njys, x > y ] | x <- njxs ]
-- Guard/NestJoin
njgxs1 :: [Integer]
njgxs1 = [1,2,3,4,5,6,7,8,12]
njgys1 :: [Integer]
njgys1 = [2,3,2,4,5,5,9,12,2,2,13]
njgzs1 :: [(Integer, Integer)]
njgzs1 = [(2, 20), (5, 60), (3, 30), (3, 80), (4, 40), (5, 10), (5, 30), (12, 120)]
njg1 :: [Integer] -> [(Integer, Integer)] -> [Integer]
njg1 njgxs njgzs =
[ x
| x <- njgxs
, x < 8
, sum [ snd z | z <- njgzs, fst z == x ] > 100
]
njg2 :: [Integer] -> [Integer] -> [Integer]
njg2 njgxs njgys =
[ x
| x <- njgxs
, and [ y > 1 | y <- njgys, x == y ]
, x < 8
]
njg3 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> [(Integer, Integer)]
njg3 njgxs njgys njgzs =
[ pair x y
| x <- njgxs
, y <- njgys
, length [ () | z <- njgzs, fst z == x ] > 2
]
njg4 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> [Integer]
njg4 njgxs njgys njgzs =
[ x
| x <- njgxs
, length [ () | y <- njgys, x == y ]
> length [ () | z <- njgzs, fst z == x ]
]
njg5 :: [Integer] -> [Integer] -> [Integer]
njg5 njgxs njgys =
[ x
| x <- njgxs
, sum [ y | y <- njgys, x < y, y > 5 ] < 10
]
--------------------------------------------------------------------------------
--
prop_deep_iter :: ([Integer], [Integer], [Integer], [Integer], [Integer]) -> Property
prop_deep_iter = makeProp C.deep_iter deep_iter_native
where
deep_iter_native (ws1, ws2, xs, ys, zs) =
[ [ [ [ w1 * 23 - y | w1 <- ws1 ]
++
[ w2 + 42 - y | w2 <- ws2 ]
| z <- zs
, z > x
]
| y <- ys
]
| x <- xs
]