Initial testsuite
authorMax Bolingbroke <batterseapower@hotmail.com>
Sun, 8 Feb 2009 21:40:28 +0000 (21:40 +0000)
committerMax Bolingbroke <batterseapower@hotmail.com>
Sun, 8 Feb 2009 21:40:28 +0000 (21:40 +0000)
tests/LICENSE [new file with mode: 0644]
tests/Main.hs [new file with mode: 0644]
tests/Properties.hs [new file with mode: 0644]
tests/Setup.hs [new file with mode: 0644]
tests/Utilities.hs [new file with mode: 0644]
tests/vector-tests.cabal [new file with mode: 0644]

diff --git a/tests/LICENSE b/tests/LICENSE
new file mode 100644 (file)
index 0000000..5187a3c
--- /dev/null
@@ -0,0 +1,31 @@
+Copyright (c) 2001-2002, Manuel M T Chakravarty & Gabriele Keller
+Copyright (c) 2006-2007, Manuel M T Chakravarty & Roman Leshchinskiy
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644 (file)
index 0000000..56674a7
--- /dev/null
@@ -0,0 +1,7 @@
+module Main (main) where
+
+import Properties (tests)
+
+import Test.Framework (defaultMain)
+
+main = defaultMain tests
\ No newline at end of file
diff --git a/tests/Properties.hs b/tests/Properties.hs
new file mode 100644 (file)
index 0000000..1d97673
--- /dev/null
@@ -0,0 +1,168 @@
+{-# LANGUAGE FlexibleContexts, Rank2Types, ScopedTypeVariables #-}
+
+module Properties (tests) where
+
+import Utilities
+
+import qualified Data.Vector.IVector as V
+import qualified Data.Vector
+import qualified Data.Vector.Unboxed
+
+import Test.QuickCheck
+
+import Test.Framework
+import Test.Framework.Providers.QuickCheck
+
+import Text.Show.Functions
+import Data.List (foldl', foldl1', unfoldr)
+
+testVersusLists :: forall a v.
+                    (Eq a,     Ord a,
+                     Eq (v a), Ord (v a),
+                     Show a,        Arbitrary a,        Model a a,
+                     -- This would be slightly nicer if we could put forall quantifiers in the class requirements!
+                     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)
+                     => v a
+                     -> [Test]
+testVersusLists _ = [
+        testGroup "Prelude"   prelude_tests,
+        testGroup "Data.List" data_list_tests,
+        testGroup "Extras"    extra_tests
+    ]
+  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_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 "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 "head"         prop_head,
+            testProperty "tail"         prop_tail,
+            testProperty "init"         prop_init,
+            testProperty "last"         prop_last,
+            --testProperty "maximum"      prop_maximum,
+            --testProperty "minimum"      prop_minimum,
+            testProperty "unfoldr"      prop_unfoldr,
+            testProperty "(==)"         prop_eq,
+            testProperty "compare"      prop_compare
+        ]
+    
+    -- TODO: implement Vector equivalents for the commented out list functions from Prelude
+    --prop_concat       = (V.concat :: [v a] -> v a)                    `eq1` concat
+    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_cons         = (V.cons :: a -> v a -> v a)                   `eq2` (:)
+    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
+    prop_takeWhile    = (V.takeWhile :: (a -> Bool) -> v a -> v a)    `eq2` takeWhile
+    prop_filter       = (V.filter :: (a -> Bool) -> v a -> v a)       `eq2` filter
+    prop_map          = (V.map :: (a -> a) -> v a -> v a)             `eq2` map
+    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_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_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
+    
+    data_list_tests = [
+            testProperty "foldl'"       prop_foldl',
+            testProperty "foldl1'"      prop_foldl1',
+            testProperty "unfoldr"      prop_unfoldr
+            --testProperty "transpose"    prop_transpose,
+            --testProperty "group"        prop_group,
+            --testProperty "inits"        prop_inits,
+            --testProperty "tails"        prop_tails,
+            --testProperty "find"         prop_find,
+            --testProperty "findIndices"  prop_findIndices,
+            --testProperty "findIndex"    prop_findIndex,
+            --testProperty "isPrefixOf"   prop_isPrefixOf,
+            --testProperty "elemIndex"    prop_elemIndex,
+            --testProperty "elemIndices"  prop_elemIndices,
+            --testProperty "mapAccumL"    prop_mapAccumL,
+            --testProperty "mapAccumR"    prop_mapAccumR,
+        ]
+    
+    -- 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_unfoldr      = ((\n f a -> V.take n $ V.unfoldr f a) :: Int -> (Int -> Maybe (a, Int)) -> Int -> v a)
+                        `eq3` (\n f a -> take n   $ unfoldr f a)
+    --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_find         = V.find        `eq2` (find        :: (a -> Bool) -> v a -> Maybe a)
+    --prop_findIndices  = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> [Int])
+    --prop_findIndex    = V.findIndex   `eq2` (findIndex   :: (a -> Bool) -> v a -> Maybe 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_mapAccumL  = eq3
+    --    (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B   -> (X, B))
+    --    (  mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
+    -- 
+    --prop_mapAccumR  = eq3
+    --    (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B   -> (X, B))
+    --    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
+
+    extra_tests = [
+            testProperty "snoc"         prop_snoc
+        ]
+
+    -- TODO: add tests for the other extra functions
+    snoc xs x = xs ++ [x]
+    prop_snoc = (V.snoc :: v a -> a -> v a)                   `eq2` snoc
+
+tests = [
+        testGroup "Data.Vector.Vector"                (testVersusLists (undefined :: Data.Vector.Vector Int)),
+        testGroup "Data.Vector.Unboxed.Vector (Int)"  (testVersusLists (undefined :: Data.Vector.Unboxed.Vector Int)),
+        testGroup "Data.Vector.Unboxed.Vector (Bool)" (testVersusLists (undefined :: Data.Vector.Unboxed.Vector Bool))
+    ]
\ No newline at end of file
diff --git a/tests/Setup.hs b/tests/Setup.hs
new file mode 100644 (file)
index 0000000..200a2e5
--- /dev/null
@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+
diff --git a/tests/Utilities.hs b/tests/Utilities.hs
new file mode 100644 (file)
index 0000000..671a1cf
--- /dev/null
@@ -0,0 +1,48 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}
+
+module Utilities where
+
+import Test.QuickCheck
+
+import qualified Data.Vector as DV
+import qualified Data.Vector.Unboxed as DVU
+import qualified Data.Vector.IVector as DVI
+import Data.Vector.Unboxed.Unbox (Unbox)
+
+
+instance Arbitrary a => Arbitrary (DV.Vector a) where
+    arbitrary = fmap DV.fromList arbitrary
+    coarbitrary = coarbitrary . DV.toList
+
+instance (Arbitrary a, Unbox a) => Arbitrary (DVU.Vector a) where
+    arbitrary = fmap DVU.fromList arbitrary
+    coarbitrary = coarbitrary . DVU.toList
+
+
+class Model a b | a -> b where
+  -- | Convert a concrete value into an abstract model
+  model :: a -> b
+
+-- The meat of the models
+instance            Model (DV.Vector a)  [a] where model = DV.toList
+instance Unbox a => Model (DVU.Vector a) [a] where model = DVU.toList
+
+-- Identity models
+instance Model Bool     Bool     where model = id
+instance Model Int      Int      where model = id
+instance Model Ordering Ordering where model = id
+
+-- Functorish models
+-- All of these need UndecidableInstances although they are actually well founded. Oh well.
+instance Model a b              => Model (Maybe a) (Maybe b) where model        = fmap model
+instance (Model a c, Model b d) => Model (a, b) (c, d)       where model (a, b) = (model a, model b)
+instance (Model c a, Model b d) => Model (a -> b) (c -> d)   where model f = model . f . model
+
+
+eq1 f g = \a     -> model (f a)     == g (model a)
+eq2 f g = \a b   -> model (f a b)   == g (model a) (model b)
+eq3 f g = \a b c -> model (f a b c) == g (model a) (model b) (model c)
+
+eqNotNull1 f g = \x     -> (not (DVI.null x)) ==> eq1 f g x
+eqNotNull2 f g = \x y   -> (not (DVI.null y)) ==> eq2 f g x y
+eqNotNull3 f g = \x y z -> (not (DVI.null z)) ==> eq3 f g x y z
diff --git a/tests/vector-tests.cabal b/tests/vector-tests.cabal
new file mode 100644 (file)
index 0000000..52ca0d7
--- /dev/null
@@ -0,0 +1,28 @@
+Name:           vector-tests
+Version:        0.2
+License:        BSD3
+License-File:   LICENSE
+Author:         Roman Leshchinskiy
+Maintainer:     Roman Leshchinskiy <rl@cse.unsw.edu.au>
+Copyright:      (c) Roman Leshchinskiy 2008
+Homepage:       http://darcs.haskell.org/vector
+Category:       Data Structures
+Synopsis:       Efficient Arrays
+Description:
+        Tests for the vector package
+
+Cabal-Version:  >= 1.2
+Build-Type:     Simple
+
+Executable "vector-tests"
+  Main-Is:  Main.hs
+
+  Extensions: ScopedTypeVariables,
+              MultiParamTypeClasses,
+              FlexibleContexts,
+              Rank2Types,
+              FunctionalDependencies,
+              UndecidableInstances
+
+  Build-Depends: base, vector, QuickCheck,
+                 test-framework, test-framework-quickcheck
\ No newline at end of file