Massive overhaul to testsuite structure
authorMax Bolingbroke <batterseapower@hotmail.com>
Mon, 9 Feb 2009 19:16:36 +0000 (19:16 +0000)
committerMax Bolingbroke <batterseapower@hotmail.com>
Mon, 9 Feb 2009 19:16:36 +0000 (19:16 +0000)
tests/Boilerplater.hs [new file with mode: 0644]
tests/Properties.hs
tests/Utilities.hs
tests/vector-tests.cabal

diff --git a/tests/Boilerplater.hs b/tests/Boilerplater.hs
new file mode 100644 (file)
index 0000000..03cb4f0
--- /dev/null
@@ -0,0 +1,27 @@
+module Boilerplater where
+
+import Test.Framework.Providers.QuickCheck
+
+import Language.Haskell.TH
+
+
+testProperties :: [Name] -> Q Exp
+testProperties nms = fmap ListE $ sequence [[| testProperty $(stringE prop_name) $(varE nm) |]
+                                           | nm <- nms
+                                           , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]]
+
+-- This nice clean solution doesn't quite work since I need to use lexically-scoped type
+-- variables, which aren't supported by Template Haskell. Argh!
+-- testProperties :: Q [Dec] -> Q Exp
+-- testProperties mdecs = do
+--     decs <- mdecs
+--     property_exprs <- sequence [[| testProperty "$prop_name" $(return $ VarE nm) |]
+--                                | FunD nm _clauses <- decs
+--                                , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]]
+--     return $ LetE decs (ListE property_exprs)
+
+stripPrefix_maybe :: String -> String -> Maybe String
+stripPrefix_maybe prefix what
+  | what_start == prefix = Just what_end
+  | otherwise            = Nothing
+  where (what_start, what_end) = splitAt (length prefix) what
\ No newline at end of file
index 760047d..9d94111 100644 (file)
@@ -1,7 +1,6 @@
-{-# LANGUAGE CPP, FlexibleContexts, Rank2Types, ScopedTypeVariables, PatternGuards #-}
-
 module Properties (tests) where
 
+import Boilerplater
 import Utilities
 
 import qualified Data.Vector.IVector as V
@@ -14,26 +13,40 @@ import Test.QuickCheck
 import Test.Framework
 import Test.Framework.Providers.QuickCheck
 
-import Text.Show.Functions
-import Data.List (foldl', foldl1', unfoldr, find, findIndex)
+import Text.Show.Functions ()
+import Data.List           (foldl', foldl1', unfoldr, find, findIndex)
 
-#define HUGE_CLASS_CONTEXT(a, v) \
-  Enum a, \
-  Eq a,     Ord a, \
-  Eq (v a), Ord (v a), \
-  Show a,        Arbitrary a,        Model a a, \
-  Show (v a),    Arbitrary (v a),    Model (v a) [a],       V.IVector v a, \
-  Show (v Bool), Arbitrary (v Bool), Model (v Bool) [Bool], V.IVector v Bool
+#define COMMON_CONTEXT(a, v) \
+  Eq a, Eq (v a), \
+  Show a,     Arbitrary a,     Model a a, \
+  Show (v a), Arbitrary (v a), Model (v a) [a], V.IVector v a
 
 
-testVectorType :: forall a v. (HUGE_CLASS_CONTEXT(a, v)) => v a -> [Test]
-testVectorType dummy = [
-        testGroup "Sanity checks"                (testSanity dummy),
-        testGroup "Semantics should match lists" (testVersusLists dummy),
-        testGroup "Non-list functions correct"   (testExtraFunctions dummy)
-    ]
+-- TODO: implement Vector equivalents for some of the commented out list functions from Prelude
+-- TODO: test and implement some of these other functions:
+--  mapM *
+--  mapM_ *
+--  sequence
+--  sequence_
+--  sum *
+--  product *
+--  scanl *
+--  scanl1 *
+--  scanr *
+--  scanr1 *
+--  lookup *
+--  zip3 *
+--  zipWith3 *
+--  unzip *
+--  unzip3 *
+--  lines
+--  words
+--  unlines
+--  unwords
+-- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.
+-- Ones with *s are the most plausible candidates.
 
-testSanity :: forall a v. (HUGE_CLASS_CONTEXT(a, v)) => v a -> [Test]
+testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
 testSanity _ = [
         testProperty "fromList.toList == id" prop_fromList_toList,
         testProperty "toList.fromList == id" prop_toList_fromList,
@@ -46,71 +59,36 @@ testSanity _ = [
     prop_unstream_stream (v :: v a)        = (V.unstream . V.stream)                        v == v
     prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s
 
-testVersusLists :: forall a v. (HUGE_CLASS_CONTEXT(a, v)) => v a -> [Test]
-testVersusLists _ = [
-        testGroup "Prelude"   prelude_tests,
-        testGroup "Data.List" data_list_tests
-    ]
+testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
+testPolymorphicFunctions _ = $(testProperties [
+        'prop_eq, 'prop_length, 'prop_null, 'prop_reverse,
+        'prop_append, 'prop_concatMap,
+        'prop_empty, 'prop_cons,
+        'prop_head, 'prop_tail, 'prop_init, 'prop_last,
+        'prop_drop, 'prop_dropWhile, 'prop_take, 'prop_takeWhile,
+        'prop_filter, 'prop_map, 'prop_zipWith, 'prop_replicate,
+        'prop_elem, 'prop_notElem,
+        'prop_foldr, 'prop_foldl, 'prop_foldr1, 'prop_foldl1,
+        'prop_foldl', 'prop_foldl1',
+        'prop_find, 'prop_findIndex,
+        'prop_unfoldr,
+        'prop_singleton, 'prop_snoc
+    ])
   where
-    prelude_tests = [
-            --testProperty "concat"       prop_concat,
-            testProperty "length"       prop_length,
-            testProperty "null"         prop_null,
-            testProperty "reverse"      prop_reverse,
-            --testProperty "all"          prop_all,
-            --testProperty "any"          prop_any,
-            testProperty "and"          prop_and,
-            testProperty "or"           prop_or,
-            testProperty "(++)"         prop_append,
-            --testProperty "break"        prop_break,
-            testProperty "concatMap"    prop_concatMap,
-            testProperty "[]"           prop_empty,
-            testProperty "(:)"          prop_cons,
-            testProperty "drop"         prop_drop,
-            testProperty "dropWhile"    prop_dropWhile,
-            testProperty "take"         prop_take,
-            testProperty "takeWhile"    prop_takeWhile,
-            testProperty "filter"       prop_filter,
-            testProperty "map"          prop_map,
-            --testProperty "zip"          prop_zip,
-            testProperty "zipWith"      prop_zipWith,
-            testProperty "replicate"    prop_replicate,
-            --testProperty "span"         prop_span,
-            --testProperty "splitAt"      prop_splitAt,
-            testProperty "elem"         prop_elem,
-            testProperty "notElem"      prop_notElem,
-            testProperty "foldr"        prop_foldr,
-            testProperty "foldl"        prop_foldl,
-            testProperty "foldl'"       prop_foldl',
-            --testProperty "lines"        prop_lines,
-            testProperty "foldr1"       prop_foldr1,
-            testProperty "foldl1"       prop_foldl1,
-            testProperty "foldl1'"      prop_foldl1',
-            --testProperty "(!)"          prop_index,
-            testProperty "head"         prop_head,
-            testProperty "tail"         prop_tail,
-            testProperty "init"         prop_init,
-            testProperty "last"         prop_last,
-            --testProperty "maximum"      prop_maximum,
-            --testProperty "minimum"      prop_minimum,
-            testProperty "(==)"         prop_eq,
-            testProperty "compare"      prop_compare
-        ]
-    
-    -- TODO: implement Vector equivalents for some of the commented out list functions from Prelude
-    --prop_concat       = (V.concat :: [v a] -> v a)                    `eq1` concat
+    -- Prelude
+    prop_eq           = ((==) :: v a -> v a -> Bool)                  `eq2` (==)
     prop_length       = (V.length :: v a -> Int)                      `eq1` length
     prop_null         = (V.null :: v a -> Bool)                       `eq1` null
     prop_reverse      = (V.reverse :: v a -> v a)                     `eq1` reverse
-    --prop_all          = (V.all :: (a -> Bool) -> v a -> Bool)         `eq2` all
-    --prop_any          = (V.any :: (a -> Bool) -> v a -> Bool)         `eq2` any
-    prop_and          = (V.and :: v Bool -> Bool)                     `eq1` and
-    prop_or           = (V.or :: v Bool -> Bool)                      `eq1` or
     prop_append       = ((V.++) :: v a -> v a -> v a)                 `eq2` (++)
-    --prop_break        = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
     prop_concatMap    = (V.concatMap :: (a -> v a) -> v a -> v a)     `eq2` concatMap
     prop_empty        = (V.empty :: v a)                              `eq0` []
     prop_cons         = (V.cons :: a -> v a -> v a)                   `eq2` (:)
+    --prop_index        = compare (V.!) to (!!)
+    prop_head         = (V.head :: v a -> a)                          `eqNotNull1` head
+    prop_tail         = (V.tail :: v a -> v a)                        `eqNotNull1` tail
+    prop_init         = (V.init :: v a -> v a)                        `eqNotNull1` init
+    prop_last         = (V.last :: v a -> a)                          `eqNotNull1` last
     prop_drop         = (V.drop :: Int -> v a -> v a)                 `eq2` drop
     prop_dropWhile    = (V.dropWhile :: (a -> Bool) -> v a -> v a)    `eq2` dropWhile
     prop_take         = (V.take :: Int -> v a -> v a)                 `eq2` take
@@ -121,57 +99,27 @@ testVersusLists _ = [
     prop_zipWith      = (V.zipWith :: (a -> a -> a) -> v a -> v a -> v a) `eq3` zipWith
     prop_replicate    = (V.replicate :: Int -> a -> v a)              `eq2` replicate
     --prop_span         = (V.span :: (a -> Bool) -> v a -> (v a, v a))  `eq2` span
+    --prop_break        = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
     --prop_splitAt      = (V.splitAt :: Int -> v a -> (v a, v a))       `eq2` splitAt
     prop_elem         = (V.elem :: a -> v a -> Bool)                  `eq2` elem
     prop_notElem      = (V.notElem :: a -> v a -> Bool)               `eq2` notElem
-    --prop_lines        = (V.lines :: String -> [String])               `eq1` lines
     prop_foldr        = (V.foldr :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldr
     prop_foldl        = (V.foldl :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldl
     prop_foldr1       = (V.foldr1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldr1
     prop_foldl1       = (V.foldl1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldl1
-    --prop_index        = compare (V.!) to (!!)
-    prop_head         = (V.head :: v a -> a)                          `eqNotNull1` head
-    prop_tail         = (V.tail :: v a -> v a)                        `eqNotNull1` tail
-    prop_init         = (V.init :: v a -> v a)                        `eqNotNull1` init
-    prop_last         = (V.last :: v a -> a)                          `eqNotNull1` last
-    --prop_maximum      = (V.maximum :: v a -> a)                       `eqNotNull1` maximum
-    --prop_minimum      = (V.minimum :: v a -> a)                       `eqNotNull1` minimum
-    prop_eq           = ((==) :: v a -> v a -> Bool)                  `eq2` (==)
-    prop_compare      = (compare :: v a -> v a -> Ordering)           `eq2` compare
-    prop_enumFromTo   = (V.enumFromTo :: a -> a -> v a)               `eq2` enumFromTo
-    prop_enumFromThenTo = (V.enumFromThenTo :: a -> a -> a -> v a)    `eq3` enumFromThenTo
-    
-    data_list_tests = [
-            testProperty "foldl'"       prop_foldl',
-            testProperty "foldl1'"      prop_foldl1',
-            testProperty "unfoldr"      prop_unfoldr,
-            testProperty "find"         prop_find,
-            testProperty "findIndex"    prop_findIndex
-            --testProperty "transpose"    prop_transpose,
-            --testProperty "group"        prop_group,
-            --testProperty "inits"        prop_inits,
-            --testProperty "tails"        prop_tails,
-            --testProperty "findIndices"  prop_findIndices,
-            --testProperty "isPrefixOf"   prop_isPrefixOf,
-            --testProperty "elemIndex"    prop_elemIndex,
-            --testProperty "elemIndices"  prop_elemIndices,
-            --testProperty "mapAccumL"    prop_mapAccumL,
-            --testProperty "mapAccumR"    prop_mapAccumR,
-        ]
-    
+    --prop_all          = (V.all :: (a -> Bool) -> v a -> Bool)         `eq2` all
+    --prop_any          = (V.any :: (a -> Bool) -> v a -> Bool)         `eq2` any
+
+    -- Data.List
     -- TODO: implement Vector equivalents for some of the commented out list functions from Data.List
     prop_foldl'       = (V.foldl' :: (a -> a -> a) -> a -> v a -> a)     `eq3` foldl'
     prop_foldl1'      = (V.foldl1' :: (a -> a -> a) -> v a -> a)         `eqNotNull2` foldl1'
     prop_find         = (V.find :: (a -> Bool) -> v a -> Maybe a)        `eq2` find
     prop_findIndex    = (V.findIndex :: (a -> Bool) -> v a -> Maybe Int) `eq2` findIndex
-    --prop_transpose    = V.transpose   `eq1` (transpose   :: [v a] -> [v a])
-    --prop_group        = V.group       `eq1` (group       :: v a -> [v a])
-    --prop_inits        = V.inits       `eq1` (inits       :: v a -> [v a])
-    --prop_tails        = V.tails       `eq1` (tails       :: v a -> [v a])
-    --prop_findIndices  = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> [Int])
+    --prop_findIndices  = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)
     --prop_isPrefixOf   = V.isPrefixOf  `eq2` (isPrefixOf  :: v a -> v a -> Bool)
     --prop_elemIndex    = V.elemIndex   `eq2` (elemIndex   :: a -> v a -> Maybe Int)
-    --prop_elemIndices  = V.elemIndices `eq2` (elemIndices :: a -> v a -> [Int])
+    --prop_elemIndices  = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)
     --
     --prop_mapAccumL  = eq3
     --    (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B   -> (X, B))
@@ -180,7 +128,7 @@ testVersusLists _ = [
     --prop_mapAccumR  = eq3
     --    (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B   -> (X, B))
     --    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
-    
+
     -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This
     -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.
     limitUnfolds f (theirs, ours) | ours >= 0
@@ -189,12 +137,7 @@ testVersusLists _ = [
     prop_unfoldr      = ((\n f a -> V.unfoldr (limitUnfolds f) (a, n)) :: Int -> ((Int, Int) -> Maybe (a, (Int, Int))) -> (Int, Int) -> v a)
                         `eq3` (\n f a -> unfoldr (limitUnfolds f) (a, n))
 
-testExtraFunctions :: forall a v. (HUGE_CLASS_CONTEXT(a, v)) => v a -> [Test]
-testExtraFunctions _ =  [
-        testProperty "singleton"    prop_singleton,
-        testProperty "snoc"         prop_snoc
-    ]
-  where
+    -- Extras
     singleton x = [x]
     prop_singleton = (V.singleton :: a -> v a) `eq1` singleton
     
@@ -211,11 +154,71 @@ testExtraFunctions _ =  [
     --  unsafeSlice, unsafeIndex,
     --  vlength, vnew
 
+testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]
+testOrdFunctions _ = $(testProperties ['prop_compare])
+  where
+    prop_compare      = (compare :: v a -> v a -> Ordering) `eq2` compare
+    --prop_maximum      = (V.maximum :: v a -> a)             `eqNotNull1` maximum
+    --prop_minimum      = (V.minimum :: v a -> a)             `eqNotNull1` minimum
+
+testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a) => v a -> [Test]
+testEnumFunctions _ = $(testProperties ['prop_enumFromTo, 'prop_enumFromThenTo])
+  where
+    prop_enumFromTo     =                                        (V.enumFromTo :: a -> a -> v a)          `eq2` enumFromTo
+    prop_enumFromThenTo = \i j n -> fromEnum i < fromEnum j ==> ((V.enumFromThenTo :: a -> a -> a -> v a) `eq3` enumFromThenTo) i j n
+
+testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test]
+testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])
+  where
+    prop_and          = (V.and :: v Bool -> Bool) `eq1` and
+    prop_or           = (V.or :: v Bool -> Bool)  `eq1` or
+
+testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test]
+testNumFunctions _ = $(testProperties [])
+  where
+    --prop_sum          = (V.sum :: v Int -> Int)     `eq1` sum
+    --prop_product      = (V.product :: v Int -> Int) `eq1` product
+
+testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
+testNestedVectorFunctions _ = $(testProperties [])
+  where
+    -- Prelude
+    --prop_concat       = (V.concat :: [v a] -> v a)                    `eq1` concat
+    
+    -- Data.List
+    --prop_transpose    = V.transpose   `eq1` (transpose   :: [v a] -> [v a])
+    --prop_group        = V.group       `eq1` (group       :: v a -> [v a])
+    --prop_inits        = V.inits       `eq1` (inits       :: v a -> [v a])
+    --prop_tails        = V.tails       `eq1` (tails       :: v a -> [v a])
+
+
+testGeneralBoxedVector dummy = concatMap ($ dummy) [
+        testSanity,
+        testPolymorphicFunctions,
+        testOrdFunctions,
+        testEnumFunctions,
+        testNestedVectorFunctions
+    ]
+
+testBoolBoxedVector dummy = testGeneralBoxedVector dummy ++ testBoolFunctions dummy
+testNumericBoxedVector dummy = testGeneralBoxedVector dummy ++ testNumFunctions dummy
+
+testGeneralUnboxedVector dummy = concatMap ($ dummy) [
+        testSanity,
+        testPolymorphicFunctions,
+        testOrdFunctions,
+        testEnumFunctions
+    ]
+
+testBoolUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testBoolFunctions dummy
+testNumericUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testNumFunctions dummy
+
 -- TODO: test non-IVector stuff?
 tests = [
-        testGroup "Data.Vector.Vector"                  (testVectorType (undefined :: Data.Vector.Vector Int)),
-        testGroup "Data.Vector.Unboxed.Vector (Bool)"   (testVectorType (undefined :: Data.Vector.Unboxed.Vector Bool)),
-        testGroup "Data.Vector.Unboxed.Vector (Int)"    (testVectorType (undefined :: Data.Vector.Unboxed.Vector Int)),
-        testGroup "Data.Vector.Unboxed.Vector (Float)"  (testVectorType (undefined :: Data.Vector.Unboxed.Vector Float)),
-        testGroup "Data.Vector.Unboxed.Vector (Double)" (testVectorType (undefined :: Data.Vector.Unboxed.Vector Double))
+        testGroup "Data.Vector.Vector (Bool)"           (testBoolBoxedVector      (undefined :: Data.Vector.Vector Bool)),
+        testGroup "Data.Vector.Vector (Int)"            (testNumericBoxedVector   (undefined :: Data.Vector.Vector Int)),
+        testGroup "Data.Vector.Unboxed.Vector (Bool)"   (testBoolUnboxedVector    (undefined :: Data.Vector.Unboxed.Vector Bool)),
+        testGroup "Data.Vector.Unboxed.Vector (Int)"    (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)),
+        testGroup "Data.Vector.Unboxed.Vector (Float)"  (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float)),
+        testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double))
     ]
\ No newline at end of file
index 31c2f93..4322366 100644 (file)
@@ -1,5 +1,3 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, UndecidableInstances #-}
-
 module Utilities where
 
 import Test.QuickCheck
index 7b9b5c5..87a97e3 100644 (file)
@@ -25,10 +25,14 @@ Executable "vector-tests"
               Rank2Types,
               FunctionalDependencies,
               TypeSynonymInstances,
-              UndecidableInstances
+              UndecidableInstances,
+              TemplateHaskell
 
-  Build-Depends: base, vector, QuickCheck,
-                 test-framework, test-framework-quickcheck
+  Build-Depends: base, template-haskell, vector,
+                 QuickCheck, test-framework, test-framework-quickcheck
 
   -- Don't let fusion occur or GHC will make our tests less informative in some cases :-)
-  Ghc-Options: -O0
\ No newline at end of file
+  Ghc-Options: -O0
+  
+  -- It's good practice to show all warnings, but since this is just test code let's ignore type sigs
+  Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures
\ No newline at end of file