packages feed

vector 0.3 → 0.3.1

raw patch · 9 files changed

+412/−2 lines, 9 files

Files

Data/Vector/IVector.hs view
@@ -133,7 +133,7 @@   -- With 'unsafeIndexM', we can do   --   -- > copy mv v ... = ... case unsafeIndexM v i of-  --                         Box x -> unsafeWrite mv i x ...+  -- >                       Box x -> unsafeWrite mv i x ...   --   -- which does not have this problem because indexing (but not the returned   -- element!) is evaluated immediately.
+ tests/Boilerplater.hs view
@@ -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
+ tests/LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009, Max Bolingbroke and 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.+
+ tests/Main.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Properties (tests)++import Test.Framework (defaultMain)++main = defaultMain tests
+ tests/Properties.hs view
@@ -0,0 +1,235 @@+module Properties (tests) where++import Boilerplater+import Utilities++import qualified Data.Vector.IVector as V+import qualified Data.Vector+import qualified Data.Vector.Unboxed+import qualified Data.Vector.Fusion.Stream as S++import Test.QuickCheck++import Test.Framework+import Test.Framework.Providers.QuickCheck++import Text.Show.Functions ()+import Data.List           (foldl', foldl1', unfoldr, find, findIndex)++#define COMMON_CONTEXT(a, v) \+ VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v)++#define VANILLA_CONTEXT(a, v) \+  Eq a,     Show a,     Arbitrary a,     Model a a++#define VECTOR_CONTEXT(a, v) \+  Eq (v a), Show (v a), Arbitrary (v a), Model (v a) [a], V.IVector v a+++-- TODO: implement Vector equivalents of list functions for some of the commented out properties++-- TODO: test and implement some of these other Prelude functions:+--  mapM *+--  mapM_ *+--  sequence+--  sequence_+--  sum *+--  product *+--  scanl *+--  scanl1 *+--  scanr *+--  scanr1 *+--  lookup *+--  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.++-- TODO: add tests for the other extra functions+-- IVector exports still needing tests:+--  copy,+--  slice,+--  (//), update, bpermute,+--  prescanl, prescanl',+--  new,+--  unsafeSlice, unsafeIndex,+--  vlength, vnew++-- TODO: test non-IVector stuff?++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,+        testProperty "unstream.stream == id" prop_unstream_stream,+        testProperty "stream.unstream == id" prop_stream_unstream+    ]+  where+    prop_fromList_toList (v :: v a)        = (V.fromList . V.toList)                        v == v+    prop_toList_fromList (l :: [a])        = ((V.toList :: v a -> [a]) . V.fromList)        l == l+    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++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_replicate,+        'prop_zipWith, 'prop_zipWith3,+        '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+    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_append       = ((V.++) :: v a -> v a -> v a)                 `eq2` (++)+    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+    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_zipWith      = (V.zipWith :: (a -> a -> a) -> v a -> v a -> v a) `eq3` zipWith+    prop_zipWith3     = (V.zipWith3 :: (a -> a -> a -> a) -> v a -> v a -> v a -> v a) `eq4` zipWith3+    --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_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_all          = (V.all :: (a -> Bool) -> v a -> Bool)         `eq2` all+    --prop_any          = (V.any :: (a -> Bool) -> v a -> Bool)         `eq2` any++    -- 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_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 -> v 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]))++    -- 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+                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))+                                  | otherwise                       = Nothing+    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))++    -- Extras+    singleton x = [x]+    prop_singleton = (V.singleton :: a -> v a) `eq1` singleton+    +    snoc xs x = xs ++ [x]+    prop_snoc = (V.snoc :: v a -> a -> v a) `eq2` snoc++testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test]+testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3])+  where+    prop_zip          = (V.zip :: v a -> v a -> v (a, a))             `eq2` zip+    prop_zip3         = (V.zip3 :: v a -> v a -> v a -> v (a, a, a))  `eq3` zip3+    prop_unzip        = (V.unzip :: v (a, a) -> (v a, v a))           `eq1` unzip+    prop_unzip3       = (V.unzip3 :: v (a, a, a) -> (v a, v a, v a))  `eq1` unzip3++testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]+testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum])+  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 ['prop_sum, 'prop_product])+  where+    prop_sum          = (V.sum :: v a -> a)     `eq1` sum+    prop_product      = (V.product :: v a -> a) `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,+        testTuplyFunctions,+        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++tests = [+        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))+    ]
+ tests/Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ tests/Utilities.hs view
@@ -0,0 +1,61 @@+module Utilities where++import Test.QuickCheck++import qualified Data.Vector as DV+import qualified Data.Vector.IVector as DVI+import qualified Data.Vector.Unboxed as DVU+import qualified Data.Vector.Unboxed.Unbox as DVUU+import qualified Data.Vector.Fusion.Stream as S+++instance Show a => Show (S.Stream a) where+    show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s)+++instance Arbitrary a => Arbitrary (DV.Vector a) where+    arbitrary = fmap DV.fromList arbitrary+    coarbitrary = coarbitrary . DV.toList++instance (Arbitrary a, DVUU.Unbox a) => Arbitrary (DVU.Vector a) where+    arbitrary = fmap DVU.fromList arbitrary+    coarbitrary = coarbitrary . DVU.toList++instance Arbitrary a => Arbitrary (S.Stream a) where+    arbitrary = fmap S.fromList arbitrary+    coarbitrary = coarbitrary . S.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 DVUU.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 Float    Float    where model = id+instance Model Double   Double   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 a', Model b b')             => Model (a, b) (a', b')        where model (a, b)    = (model a, model b)+instance (Model a a', Model b b', Model c c') => Model (a, b, c) (a', b', c') where model (a, b, c) = (model a, model b, model c)+instance (Model c a, Model b d)               => Model (a -> b) (c -> d)      where model f         = model . f . model+++eq0 f g =             model f           == g+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)+eq4 f g = \a b c d -> model (f a b c d) == g (model a) (model b) (model c) (model d)++eqNotNull1 f g = \a       -> (not (DVI.null a)) ==> eq1 f g a+eqNotNull2 f g = \a b     -> (not (DVI.null b)) ==> eq2 f g a b+eqNotNull3 f g = \a b c   -> (not (DVI.null c)) ==> eq3 f g a b c+eqNotNull4 f g = \a b c d -> (not (DVI.null d)) ==> eq4 f g a b c d
+ tests/vector-tests.cabal view
@@ -0,0 +1,38 @@+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: CPP,+              ScopedTypeVariables,+              PatternGuards,+              MultiParamTypeClasses,+              FlexibleContexts,+              Rank2Types,+              FunctionalDependencies,+              TypeSynonymInstances,+              UndecidableInstances,+              TemplateHaskell++  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+  +  -- 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
vector.cabal view
@@ -1,5 +1,5 @@ Name:           vector-Version:        0.3+Version:        0.3.1 License:        BSD3 License-File:   LICENSE Author:         Roman Leshchinskiy@@ -16,6 +16,15 @@  Cabal-Version:  >= 1.2 Build-Type:     Simple++Extra-Source-Files:+      tests/vector-tests.cabal+      tests/LICENSE+      tests/Setup.hs+      tests/Main.hs+      tests/Boilerplater.hs+      tests/Properties.hs+      tests/Utilities.hs  Flag EnableAssertions   Description: Enable assertions that check parameters to functions are reasonable.