Permalink
Browse files

A few QuickCheck unit tests

  • Loading branch information...
1 parent a08e89c commit d6e0bced7de705377d90ed34c6015fbeb8491d82 @dybber dybber committed Nov 26, 2011
Showing with 177 additions and 0 deletions.
  1. +17 −0 tests/unit/AccelerateOpenCL_Test.hs
  2. +86 −0 tests/unit/Fold_Test.hs
  3. +38 −0 tests/unit/Map_Test.hs
  4. +36 −0 tests/unit/ZipWith_Test.hs
@@ -0,0 +1,17 @@
+module Main where
+
+import Test.Framework
+import qualified Map_Test
+import qualified Fold_Test
+import qualified ZipWith_Test
+
+-- Use plain output format, to avoid terminal color annotations
+main = do opts <- interpretArgsOrExit ["--plain"]
+ defaultMainWithOpts [tests] opts
+
+tests = testGroup "Accelerate OpenCL"
+ [ Map_Test.tests
+ , ZipWith_Test.tests
+ , Fold_Test.tests
+ ]
+
View
@@ -0,0 +1,86 @@
+module Fold_Test (tests) where
+
+import Data.Array.Accelerate (Acc, Exp, Elt, Z(..), (:.)(..))
+import qualified Data.Array.Accelerate as Acc
+import qualified Data.Array.Accelerate.Smart as Acc
+import qualified Data.Array.Accelerate.OpenCL as Acc
+
+import Test.Framework (testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck
+
+-- Convert seconds to milliseconds
+seconds n = n * 1000000
+milliseconds n = n * 1000
+
+-- Make problems larger, and limit the time used on solving each problem
+scale :: Testable a => a -> Property
+scale = within (milliseconds 400) . mapSize (*10) . property
+
+tests = testGroup "fold"
+ [
+ testProperty "fold sum, empty list" test_fold_nil_tuple
+ , testProperty "fold sum, empty list" test_fold_nil
+ , testProperty "fold sum, Int" (scale test_fold_sum)
+ , testProperty "fold sum, (Int, Int)" (scale test_fold_sumTuple)
+ , testProperty "fold1 sum, Int" (scale test_fold1_sum)
+ , testProperty "fold1 sum, (Int, Int)" (scale test_fold1_sumTuple)
+ ]
+
+-- Simultaneous addition of tuples
+add_simple (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
+
+add :: Exp (Int, Int) -> Exp (Int, Int) -> Exp (Int, Int)
+add x y = let (x1, y1) = Acc.unlift x :: (Exp Int, Exp Int)
+ (x2, y2) = Acc.unlift y :: (Exp Int, Exp Int)
+ in Acc.lift ( x1 + x2, y1 + y2)
+
+-- fold1 tests --
+test_fold1_sum :: [Int] -> Bool
+test_fold1_sum = test_fold1 (+) (+)
+
+test_fold1_sumTuple :: [(Int, Int)] -> Bool
+test_fold1_sumTuple = test_fold1 add_simple add
+
+-- fold tests --
+
+-- We do not want to test whether fold on empty list here
+test_fold_sum :: Int -> [Int] -> Property
+test_fold_sum x xs = (not $ null xs) ==> test_fold (+) (+) x xs
+
+test_fold_sumTuple :: (Int, Int) -> [(Int, Int)] -> Property
+test_fold_sumTuple x xs = (not $ null xs) ==> test_fold add_simple add x xs
+
+-- Tests the empty list case
+test_fold_nil :: Property
+test_fold_nil =
+ mapSize (const 1) $ test_fold (+) (+) (0 :: Int) []
+
+test_fold_nil_tuple :: Property
+test_fold_nil_tuple =
+ mapSize (const 1) $ test_fold add_simple add ((0,0) :: (Int, Int)) []
+
+
+-- Generic test functions
+-- | Generic fold1 test
+--
+-- Supply it with a regular function and an Accelerate function that
+-- performs the same operations, to create a QuickCheckable property
+test_fold1 :: (Eq a, Elt a)
+ => (a -> a -> a) -> (Exp a -> Exp a -> Exp a) -> [a] -> Bool
+test_fold1 _ _ [] = True -- foldl1 errors on empty list
+test_fold1 f f_acc xs = Prelude.foldl1 f xs == (head . Acc.toList $ Acc.run (doFold vector))
+ where
+ doFold = Acc.fold1 f_acc . Acc.use
+ vector = Acc.fromList (Z :. length xs) xs
+
+-- | Generic fold test
+--
+-- Supply it with a regular function and an Accelerate function that
+-- performs the same operations, to create a QuickCheckable property
+test_fold :: (Eq a, Elt a)
+ => (a -> a -> a) -> (Exp a -> Exp a -> Exp a) -> a -> [a] -> Bool
+test_fold f f_acc x xs = Prelude.foldl f x xs == (head . Acc.toList $ Acc.run (doFold vector))
+ where
+ doFold = Acc.fold f_acc (Acc.constant x) . Acc.use
+ vector = Acc.fromList (Z :. length xs) xs
View
@@ -0,0 +1,38 @@
+module Map_Test (tests) where
+
+import Data.Array.Accelerate as Acc
+import Data.Array.Accelerate.Smart as Acc
+import qualified Data.Array.Accelerate.OpenCL as Acc
+
+import Test.Framework (testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck
+
+tests = testGroup "map"
+ [ testProperty "map (+1), Float" test_mapAddOne
+ , testProperty "map square, Float" test_mapSquare
+ , testProperty "map (uncurry (+)), Float" test_mapSumTuple
+ ]
+
+-- We must explicitly mention the types that we want QuickCheck to
+-- generate as elements
+test_mapAddOne :: [Float] -> Bool
+test_mapAddOne = mkMapTest (+1) (+1)
+
+test_mapSquare :: [Float] -> Bool
+test_mapSquare = mkMapTest (\x -> x * x) (\x -> x * x)
+
+test_mapSumTuple :: [(Float,Float)] -> Bool
+test_mapSumTuple = mkMapTest (Prelude.uncurry (+)) (Acc.uncurry (+))
+
+-- | Generic map test
+--
+-- Supply it with a regular function and an Accelerate function that
+-- performs the same operations, to create a QuickCheckable property
+mkMapTest :: (Eq b, Elt a, Elt b)
+ => (a -> b) -> (Exp a -> Exp b) -> [a] -> Bool
+mkMapTest _ _ [] = True
+mkMapTest f f_acc xs = Prelude.map f xs == (Acc.toList $ Acc.run (doMap vector))
+ where
+ doMap = Acc.map f_acc . Acc.use
+ vector = Acc.fromList (Z :. length xs) xs
View
@@ -0,0 +1,36 @@
+module ZipWith_Test (tests) where
+
+import Data.Array.Accelerate as Acc
+import Data.Array.Accelerate.Smart as Acc
+import qualified Data.Array.Accelerate.OpenCL as Acc
+
+import Test.Framework (testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck
+
+tests = testGroup "zipWith"
+ [ testProperty "zipWith (+), Float Float" test_zipWithAdd
+-- , testProperty "zipWith mkTuple, (Float, Int)" test_zipWithTup
+ ]
+
+-- We must explicitly mention the types that we want QuickCheck to
+-- generate as elements
+test_zipWithAdd :: [Float] -> [Float] -> Bool
+test_zipWithAdd = mkZipWithTest (+) (+)
+
+-- test_zipWithTup :: [Float] -> [Int] -> Bool
+-- test_zipWithTup = mkZipWithTest (\x y -> (x, y)) (\x y -> (x, y))
+
+-- | Generic zipWith test
+--
+-- Supply it with a regular function and an Accelerate function that
+-- performs the same operations, to create a QuickCheckable property
+mkZipWithTest :: (Eq c, Elt a, Elt b, Elt c)
+ => (a -> b -> c) -> (Exp a -> Exp b -> Exp c) -> [a] -> [b] -> Bool
+mkZipWithTest _ _ [] _ = True
+mkZipWithTest _ _ _ [] = True
+mkZipWithTest f f_acc xs ys = Prelude.zipWith f xs ys == (Acc.toList run_zipWith)
+ where
+ run_zipWith = Acc.run (Acc.zipWith f_acc vector_xs vector_ys)
+ vector_xs = Acc.use $ Acc.fromList (Z :. length xs) xs
+ vector_ys = Acc.use $ Acc.fromList (Z :. length ys) ys

0 comments on commit d6e0bce

Please sign in to comment.