Add my (old) testsuite
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sat, 12 Sep 2009 12:52:16 +0000 (12:52 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sat, 12 Sep 2009 12:52:16 +0000 (12:52 +0000)
testsuite/Main.hs [new file with mode: 0644]
testsuite/Testsuite/Stream/AsList.hs [new file with mode: 0644]
testsuite/Testsuite/Stream/Errors.hs [new file with mode: 0644]
testsuite/Testsuite/Utils/Generator.hs [new file with mode: 0644]
testsuite/Testsuite/Utils/List.hs [new file with mode: 0644]
testsuite/Testsuite/Utils/Property.hs [new file with mode: 0644]
testsuite/Testsuite/Utils/Test.hs [new file with mode: 0644]
testsuite/Testsuite/Vector/AsList.hs [new file with mode: 0644]
testsuite/Testsuite/Vector/Errors.hs [new file with mode: 0644]

diff --git a/testsuite/Main.hs b/testsuite/Main.hs
new file mode 100644 (file)
index 0000000..39776f0
--- /dev/null
@@ -0,0 +1,13 @@
+module Main where
+
+import Testsuite.Stream as Stream
+import Testsuite.Vector as Vector
+import Testsuite.Utils.Test
+
+main =
+  do
+    (_, s) <- execTestM tests
+    mapM_ putStrLn (summarise s)
+  where
+    tests = mapM_ runTest [Stream.tests, Vector.tests]
+
diff --git a/testsuite/Testsuite/Stream/AsList.hs b/testsuite/Testsuite/Stream/AsList.hs
new file mode 100644 (file)
index 0000000..e7f80ee
--- /dev/null
@@ -0,0 +1,134 @@
+{-# LANGUAGE TypeSynonymInstances, TypeFamilies #-}
+module Testsuite.Stream.AsList ( tests ) where
+
+import Data.Vector.Fusion.Stream ( Stream )
+import qualified Data.Vector.Fusion.Stream as Stream
+import Data.List
+
+import Testsuite.Utils.Property
+import Testsuite.Utils.Test
+import Test.QuickCheck
+import Text.Show.Functions ()
+
+instance Modelled (Stream a) where
+  type Model (Stream a) = [a]
+
+  model = Stream.toList
+  unmodel = Stream.fromList
+
+prop_convert = arg_ty [A] $ \xs -> Stream.fromList xs ==? xs
+
+prop_length = arg_ty [A] $ Stream.length ==? length
+prop_null   = arg_ty [A] $ Stream.null   ==? null
+
+prop_empty = (Stream.empty :: Stream A) ==? []
+prop_singleton = arg_ty A $ Stream.singleton ==? (\x -> [x])
+prop_replicate = arg2_ty A $ Stream.replicate ==? replicate
+prop_cons = arg_ty A   $ Stream.cons ==? (:)
+prop_snoc = arg_ty [A] $ Stream.snoc ==? (\xs x -> xs ++ [x])
+prop_append = arg_ty [A] $ (Stream.++) ==? (++)
+
+prop_head  = arg (not . null) $ arg_ty [A] $ Stream.head ==? head
+prop_last  = arg (not . null) $ arg_ty [A] $ Stream.last ==? last
+prop_index = args2 (\xs i -> i >= 0 && i < length xs)
+           $ arg_ty [A] $ (Stream.!!) ==? (!!)
+
+prop_extract = arg_ty [A] $ Stream.extract ==? (\xs i j -> take j (drop i xs))
+prop_init    = arg (not . null) $ arg_ty [A] $ Stream.init ==? init
+prop_tail    = arg (not . null) $ arg_ty [A] $ Stream.tail ==? tail
+prop_take    = arg2_ty [A] $ Stream.take ==? take
+prop_drop    = arg2_ty [A] $ Stream.drop ==? drop
+
+prop_map = arg_ty (A :-> B) $ Stream.map ==? map
+prop_zipWith = arg_ty (A :-> B :-> C) $ Stream.zipWith ==? zipWith
+
+prop_filter = arg_ty (A :-> Bool) $ Stream.filter ==? filter
+prop_takeWhile = arg_ty (A :-> Bool) $ Stream.takeWhile ==? takeWhile
+prop_dropWhile = arg_ty (A :-> Bool) $ Stream.dropWhile ==? dropWhile
+
+prop_elem      = arg_ty A $ Stream.elem ==? elem
+prop_notElem   = arg_ty A $ Stream.notElem ==? notElem
+prop_find      = arg_ty (A :-> Bool) $ Stream.find ==? find
+prop_findIndex = arg_ty (A :-> Bool) $ Stream.findIndex ==? findIndex
+
+prop_foldl     = arg_ty (A :-> B :-> A) Stream.foldl ==? foldl
+prop_foldl1    = arg2 (not . null) $
+                 arg_ty (A :-> A :-> A) Stream.foldl1 ==? foldl1
+prop_foldl'    = arg_ty (A :-> B :-> A) Stream.foldl' ==? foldl'
+prop_foldl1'   = arg2 (not . null) $
+                 arg_ty (A :-> A :-> A) Stream.foldl1' ==? foldl1'
+prop_foldr     = arg_ty (A :-> B :-> B) Stream.foldr ==? foldr
+prop_foldr1    = arg2 (not . null) $
+                 arg_ty (A :-> A :-> A) Stream.foldr1 ==? foldr1
+
+prop_prescanl  = arg_ty (A :-> B :-> A)
+                 Stream.prescanl ==? (\f z -> init . scanl f z)
+prop_prescanl' = arg_ty (A :-> B :-> A)
+                 Stream.prescanl' ==? (\f z -> init . scanl f z)
+prop_postscanl  = arg_ty (A :-> B :-> A)
+                  Stream.postscanl ==? (\f z -> tail . scanl f z)
+prop_postscanl' = arg_ty (A :-> B :-> A)
+                  Stream.postscanl' ==? (\f z -> tail . scanl f z)
+prop_scanl      = arg_ty (A :-> B :-> A)
+                  Stream.scanl ==? scanl
+prop_scanl'     = arg_ty (A :-> B :-> A)
+                  Stream.scanl' ==? scanl
+prop_scanl1     = arg2 (not . null) $
+                  arg_ty (A :-> A :-> A)
+                  Stream.scanl1 ==? scanl1
+prop_scanl1'    = arg2 (not . null) $
+                  arg_ty (A :-> A :-> A)
+                  Stream.scanl1' ==? scanl1
+
+tests = "vs. list" $$? [
+                      "convert"         $? prop_convert
+
+                    , "length"          $? prop_length
+                    , "null"            $? prop_null
+
+                    , "empty"           $? prop_empty
+                    , "singleton"       $? prop_singleton
+                    , "replicate"       $? prop_replicate
+                    , "cons"            $? prop_cons
+                    , "snoc"            $? prop_snoc
+                    , "(++)"            $? prop_append
+                    , "head"            $? prop_head
+                    , "last"            $? prop_last
+                    , "(!!)"            $? prop_index
+
+                    , "extract"         $? prop_extract
+                    , "init"            $? prop_init
+                    , "tail"            $? prop_tail
+                    , "take"            $? prop_take
+                    , "drop"            $? prop_drop
+
+                    , "map"             $? prop_map
+                    , "zipWith"         $? prop_zipWith
+
+                    , "filter"          $? prop_filter
+                    , "takeWhile"       $? prop_takeWhile
+                    , "dropWhile"       $? prop_dropWhile
+
+                    , "elem"            $? prop_elem
+                    , "notElem"         $? prop_notElem
+                    , "find"            $? prop_find
+                    , "findIndex"       $? prop_findIndex
+
+                    , "foldl"           $? prop_foldl
+                    , "foldl1"          $? prop_foldl1
+                    , "foldl'"          $? prop_foldl'
+                    , "foldl1'"         $? prop_foldl1'
+                    , "foldr"           $? prop_foldr
+                    , "foldr1"          $? prop_foldr1
+
+                    , "prescanl"        $? prop_prescanl
+                    , "prescanl'"       $? prop_prescanl'
+                    , "postscanl"       $? prop_postscanl
+                    , "postscanl'"      $? prop_postscanl'
+                    , "scanl"           $? prop_scanl
+                    , "scanl'"          $? prop_scanl'
+                    , "scanl1"          $? prop_scanl1
+                    , "scanl1'"         $? prop_scanl1'
+                    ]
+
diff --git a/testsuite/Testsuite/Stream/Errors.hs b/testsuite/Testsuite/Stream/Errors.hs
new file mode 100644 (file)
index 0000000..d2765cc
--- /dev/null
@@ -0,0 +1,41 @@
+module Testsuite.Stream.Errors ( tests )
+where
+
+import           Data.Vector.Fusion.Stream  ( Stream )
+import qualified Data.Vector.Fusion.Stream as Stream
+
+import Testsuite.Utils.Test
+import Testsuite.Utils.Property
+import Test.QuickCheck.Batch
+
+consume :: Stream a -> ()
+consume = Stream.foldl' (\_ _ -> ()) ()
+
+prop_headOfEmpty = isBottom (Stream.head (Stream.empty :: Stream A))
+prop_lastOfEmpty = isBottom (Stream.last (Stream.empty :: Stream A))
+prop_indexNegative = isBottom (Stream.singleton 5 Stream.!! (-1))
+prop_indexOutOfRange = isBottom (Stream.singleton 5 Stream.!! 2)
+prop_initOfEmpty = isBottom (consume (Stream.init Stream.empty))
+prop_tailOfEmpty = isBottom (consume (Stream.tail Stream.empty))
+prop_foldl1OfEmpty = isBottom (Stream.foldl1 (\_ _ -> ()) Stream.empty)
+prop_foldl1'OfEmpty = isBottom (Stream.foldl1' (\_ _ -> ()) Stream.empty)
+prop_foldr1OfEmpty  = isBottom (Stream.foldr1 (\_ _ -> ()) Stream.empty)
+prop_scanl1OfEmpty
+  = isBottom (consume (Stream.scanl1 (\x _ -> x) Stream.empty))
+prop_scanl1'OfEmpty
+  = isBottom (consume (Stream.scanl1' (\x _ -> x) Stream.empty))
+
+tests = "errors" $$? [
+                      "head of empty"           $? prop_headOfEmpty
+                    , "last of empty"           $? prop_lastOfEmpty
+                    , "negative index"          $? prop_indexNegative
+                    , "index out of range"      $? prop_indexOutOfRange
+                    , "init of empty"           $? prop_initOfEmpty
+                    , "tail of empty"           $? prop_tailOfEmpty
+                    , "foldl1 of empty"         $? prop_foldl1OfEmpty
+                    , "foldl1' of empty"        $? prop_foldl1'OfEmpty
+                    , "foldr1 of empty"         $? prop_foldr1OfEmpty
+                    , "scanl1 of empty"         $? prop_scanl1OfEmpty
+                    , "scanl1' of empty"        $? prop_scanl1'OfEmpty
+                    ]
+
diff --git a/testsuite/Testsuite/Utils/Generator.hs b/testsuite/Testsuite/Utils/Generator.hs
new file mode 100644 (file)
index 0000000..883ff08
--- /dev/null
@@ -0,0 +1,22 @@
+module Testsuite.Utils.Generator (
+  indices, index_value_pairs
+) where
+
+import Test.QuickCheck
+
+indices :: Int -> Gen [Int]
+indices 0 = return []
+indices m = sized $ \n ->
+  do
+    len <- choose (0,n)
+    sequence [choose (0,m-1) | i <- [1..len]]
+
+index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)]
+index_value_pairs 0 = return [] 
+index_value_pairs m = sized $ \n ->
+  do
+    len <- choose (0,n)
+    is <- sequence [choose (0,m-1) | i <- [1..len]]
+    xs <- vector len
+    return $ zip is xs
+
diff --git a/testsuite/Testsuite/Utils/List.hs b/testsuite/Testsuite/Utils/List.hs
new file mode 100644 (file)
index 0000000..95e2ab0
--- /dev/null
@@ -0,0 +1,25 @@
+module Testsuite.Utils.List ( accum, (//) )
+where
+
+import Data.List
+
+accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a]
+accum f xs ps = go xs ps' 0
+  where
+    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
+
+    go (x:xs) ((i,y) : ps) j
+      | i == j     = go (f x y : xs) ps j
+    go (x:xs) ps j = x : go xs ps (j+1)
+    go [] _ _      = []  
+
+(//) :: [a] -> [(Int, a)] -> [a]
+xs // ps = go xs ps' 0
+  where
+    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
+
+    go (x:xs) ((i,y) : ps) j
+      | i == j     = go (y:xs) ps j
+    go (x:xs) ps j = x : go xs ps (j+1)
+    go [] _ _      = []
+
diff --git a/testsuite/Testsuite/Utils/Property.hs b/testsuite/Testsuite/Utils/Property.hs
new file mode 100644 (file)
index 0000000..63e09a2
--- /dev/null
@@ -0,0 +1,155 @@
+{-# LANGUAGE TypeFamilies, FlexibleContexts, GeneralizedNewtypeDeriving #-}
+module Testsuite.Utils.Property (
+  Modelled(..), EqTestable(..), (==?), A, B, C,
+
+  Ty_A(..), Ty_B(..), Ty_C(..), Ty_Bool(..), Ty_Int(..), Ty_Fn(..),
+  arg_ty, arg2_ty, arg3_ty,
+
+  arg, arg2, arg3, args2, args3
+) where
+
+import Test.QuickCheck
+
+newtype A = A_ Int deriving (Eq, Ord, Show, Arbitrary)
+newtype B = B_ Int deriving (Eq, Ord, Show, Arbitrary)
+newtype C = C_ Int deriving (Eq, Ord, Show, Arbitrary)
+
+class Modelled a where
+  type Model a
+
+  model :: a -> Model a
+  unmodel :: Model a -> a
+
+instance (Modelled a, Modelled b) => Modelled (a -> b) where
+  type Model (a -> b) = Model a -> Model b
+
+  model   f = model   . f . unmodel
+  unmodel f = unmodel . f . model
+
+instance Modelled Int where
+  type Model Int = Int
+  model = id
+  unmodel = id
+
+instance Modelled Bool where
+  type Model Bool = Bool
+  model = id
+  unmodel = id
+
+instance Modelled A where
+  type Model A = A
+
+  model = id
+  unmodel = id
+
+instance Modelled B where
+  type Model B = B
+  model = id
+  unmodel = id
+
+instance Modelled C where
+  type Model C = C
+  model = id
+  unmodel = id
+
+instance Modelled a => Modelled (Maybe a) where
+  type Model (Maybe a) = Maybe (Model a)
+
+  model = fmap model
+  unmodel = fmap unmodel
+
+instance Modelled Ordering where
+  type Model Ordering = Ordering
+
+  model = id
+  unmodel = id
+
+class Testable (EqTest a) => EqTestable a where
+  type EqTest a
+
+  (===) :: a -> a -> EqTest a
+
+instance (Arbitrary a, Show a, EqTestable b) => EqTestable (a -> b) where
+  type EqTest (a -> b) = a -> EqTest b
+
+  (f === g) x = f x === g x
+
+instance EqTestable Int where
+  type EqTest Int = Bool
+  (===) = (==)
+
+instance EqTestable Bool where
+  type EqTest Bool = Bool
+  (===) = (==)
+
+instance EqTestable A where
+  type EqTest A = Bool
+  (===) = (==)
+
+instance EqTestable B where
+  type EqTest B = Bool
+  (===) = (==)
+
+instance EqTestable C where
+  type EqTest C = Bool
+  (===) = (==)
+
+instance Eq a => EqTestable [a] where
+  type EqTest [a] = Bool
+  (===) = (==)
+
+instance Eq a => EqTestable (Maybe a) where
+  type EqTest (Maybe a) = Bool
+  (===) = (==)
+
+instance EqTestable Ordering where
+  type EqTest Ordering = Bool
+  (===) = (==)
+
+(==?) :: (Modelled a, EqTestable (Model a)) => a -> Model a -> EqTest (Model a)
+x ==? y = model x === y
+
+data Ty_A = A
+data Ty_B = B
+data Ty_C = C
+data Ty_Bool = Bool
+data Ty_Int = Int
+data Ty_Fn a b = a :-> b
+infixr 0 :->
+
+type family Ty a
+type instance Ty Ty_A = A
+type instance Ty Ty_B = B
+type instance Ty Ty_C = C
+type instance Ty Ty_Bool = Bool
+type instance Ty Ty_Int = Int
+type instance Ty (a,b) = (Ty a, Ty b)
+type instance Ty [a]  = [Ty a]
+type instance Ty (Ty_Fn a b) = Ty a -> Ty b
+
+arg_ty :: a -> (Ty a -> b) -> (Ty a -> b)
+arg_ty _ = id
+
+arg2_ty :: b -> (a -> Ty b -> c) -> (a -> Ty b -> c)
+arg2_ty _ = id
+
+arg3_ty :: c -> (a -> b -> Ty c -> d) -> (a -> b -> Ty c -> d)
+arg3_ty _ = id
+
+arg :: Testable b => (a -> Bool) -> (a -> b) -> a -> Property
+arg p f x = p x ==> f x
+
+arg2 :: Testable c => (b -> Bool) -> (a -> b -> c) -> a -> b -> Property
+arg2 p f x y = p y ==> f x y
+
+arg3 :: Testable d => (c -> Bool) -> (a -> b -> c -> d)
+                   -> a -> b -> c -> Property
+arg3 p f x y z = p z ==> f x y z
+
+args2 :: Testable c => (a -> b -> Bool) -> (a -> b -> c) -> a -> b -> Property
+args2 p f x y = p x y ==> f x y
+
+args3 :: Testable d => (a -> b -> c -> Bool) -> (a -> b -> c -> d)
+                    -> a -> b -> c -> Property
+args3 p  f x y z = p x y z ==> f x y z
+
diff --git a/testsuite/Testsuite/Utils/Test.hs b/testsuite/Testsuite/Utils/Test.hs
new file mode 100644 (file)
index 0000000..c5d01c5
--- /dev/null
@@ -0,0 +1,123 @@
+module Testsuite.Utils.Test (
+  Test, ($?), ($$?), TestS(..), summarise, TestM, execTestM, liftIO, runTest
+) where
+
+import Test.QuickCheck
+import Test.QuickCheck.Batch
+
+import System.IO       ( hFlush, stdout )
+
+data Test = Test String Property
+          | Group String [Test]
+
+($?) :: Testable a => String -> a -> Test
+name $? test = Test name (property test)
+
+($$?) :: String -> [Test] -> Test
+($$?) = Group
+
+data TestS = TestS {
+               indent         :: Int
+             , passCount      :: !Int
+             , failCount      :: !Int
+             , exhaustedCount :: !Int
+             , abortedCount   :: !Int
+             }
+
+passed :: TestS -> TestS
+passed t@(TestS {}) = t { passCount = passCount t + 1 }
+
+failed :: TestS -> TestS
+failed t@(TestS {}) = t { failCount = failCount t + 1 }
+
+exhausted :: TestS -> TestS
+exhausted t@(TestS {}) = t { exhaustedCount = exhaustedCount t + 1 }
+
+aborted :: TestS -> TestS
+aborted t@(TestS {}) = t { abortedCount = abortedCount t + 1 }
+
+summarise :: TestS -> [String]
+summarise s = concat [ [shows_n (passCount s) "passed"]
+                     , shows_nz (failCount s) "failed"
+                     , shows_nz (exhaustedCount s) "exhausted"
+                     , shows_nz (abortedCount s) "aborted"
+                     ]
+  where
+    shows_n n s = let t = show n
+                      l = length t
+                  in
+                  replicate (10 - l) ' ' ++ t ++ " " ++ s
+
+    shows_nz 0 s = []
+    shows_nz n s = [shows_n n s]
+
+newtype TestM a = TestM { runTestM :: TestS -> IO (a, TestS) }
+
+instance Monad TestM where
+  return x = TestM $ \s -> return (x,s)
+
+  TestM f >>= g = TestM $ \s ->
+                    do
+                      (x,s') <- f s
+                      runTestM (g x) s'
+
+readTestM :: (TestS -> a) -> TestM a
+readTestM f = TestM $ \s -> return (f s, s)
+
+updTestM :: (TestS -> TestS) -> TestM ()
+updTestM f = TestM $ \s -> return ((), f s)
+
+execTestM :: TestM a -> IO (a, TestS)
+execTestM (TestM f) = f $ TestS {
+                                  indent         = 0
+                                , passCount      = 0
+                                , failCount      = 0
+                                , exhaustedCount = 0
+                                , abortedCount   = 0
+                                }
+
+liftIO :: IO a -> TestM a
+liftIO p = TestM $ \s -> do
+                           x <- p
+                           return (x,s)
+
+runTest :: Test -> TestM ()
+runTest (Group name tests)
+  = do
+      ind <- readTestM indent
+      liftIO . putStrLn $ replicate (ind * 2 + 2) '*' ++ " " ++ name
+      updTestM $ \s -> s { indent = ind + 1 }
+      mapM_ runTest tests
+      updTestM $ \s -> s { indent = ind }
+runTest (Test name prop)
+  = do
+      liftIO $ do putStr $ name ++ replicate (60 - length name) ' ' ++ "... "
+                  hFlush stdout
+      res <- liftIO $ run prop defOpt
+      let (s, ss, upd) = result res
+      liftIO $ do putStrLn s
+                  hFlush stdout
+                  mapM_ (putStrLn . ("    " ++)) ss
+                  hFlush stdout
+      updTestM upd
+
+{-
+      case res of
+        TestOk _ n _ -> putStrLn $ "pass (" ++ show n ++ ")"
+        TestExausted _ n _ -> putStrLn $ "EXHAUSTED (" ++ show n ++ ")"
+        TestFailed    s n   ->
+          do
+            putStrLn $ "FAIL (" ++ show n ++ ")"
+            mapM_ putStrLn $ map ("    " ++) s
+        TestAborted e ->
+          do
+            putStrLn $ "ABORTED"
+            putStrLn $ "    " ++ show e
+-}
+
+result :: TestResult -> (String, [String], TestS -> TestS)
+result (TestOk _ _ _) = ("pass", [], passed)
+result (TestExausted _ n _) = ("EXHAUSTED", [], exhausted)
+result (TestFailed s n)     = ("FAIL", s, failed)
+result (TestAborted e)      = ("ABORTED", [show e], aborted)
+
diff --git a/testsuite/Testsuite/Vector/AsList.hs b/testsuite/Testsuite/Vector/AsList.hs
new file mode 100644 (file)
index 0000000..520dc48
--- /dev/null
@@ -0,0 +1,174 @@
+{-# LANGUAGE TypeFamilies #-}
+module Testsuite.Vector.AsList ( tests ) where
+
+import Data.Vector ( Vector )
+import qualified Data.Vector as V
+import Data.List
+
+import Testsuite.Utils.List
+import Testsuite.Utils.Property
+import Testsuite.Utils.Test
+import Testsuite.Utils.Generator
+import Test.QuickCheck
+import Text.Show.Functions ()
+
+instance Modelled (Vector a) where
+  type Model (Vector a) = [a]
+
+  model = V.toList
+  unmodel = V.fromList
+
+prop_convert = arg_ty [A] $ \xs -> V.fromList xs ==? xs
+
+prop_eq      = ((==) :: Vector A -> Vector A -> Bool) ==? (==)
+prop_compare = (compare :: Vector A -> Vector A -> Ordering) ==? compare
+
+prop_length = arg_ty [A] $ V.length ==? length
+prop_null   = arg_ty [A] $ V.null   ==? null
+
+prop_empty = (V.empty :: Vector A) ==? []
+prop_singleton = arg_ty A $ V.singleton ==? (\x -> [x])
+prop_replicate = arg2_ty A $ V.replicate ==? replicate
+prop_cons = arg_ty A   $ V.cons ==? (:)
+prop_snoc = arg_ty [A] $ V.snoc ==? (\xs x -> xs ++ [x])
+prop_append = arg_ty [A] $ (V.++) ==? (++)
+prop_copy   = arg_ty [A] $ V.copy ==? id
+
+prop_head  = arg (not . null) $ arg_ty [A] $ V.head ==? head
+prop_last  = arg (not . null) $ arg_ty [A] $ V.last ==? last
+prop_index = args2 (\xs i -> i >= 0 && i < length xs)
+           $ arg_ty [A] $ (V.!) ==? (!!)
+
+prop_slice = forAll arbitrary $ \xs ->
+             forAll (choose (0,length xs)) $ \i ->
+             forAll (choose (0,length xs - i)) $ \n ->
+             V.slice (V.fromList (xs :: [A])) i n ==? take n (drop i xs)
+prop_init    = arg (not . null) $ arg_ty [A] $ V.init ==? init
+prop_tail    = arg (not . null) $ arg_ty [A] $ V.tail ==? tail
+prop_take    = arg2_ty [A] $ V.take ==? take
+prop_drop    = arg2_ty [A] $ V.drop ==? drop
+
+prop_accum  = forAll arbitrary $ \f ->
+              forAll arbitrary $ \xs ->
+              forAll (index_value_pairs (length xs)) $ \ps ->
+              (V.accum f (V.fromList (xs :: [A])) (ps :: [(Int,B)]))
+                ==? accum f xs ps
+prop_upd    = forAll arbitrary $ \xs ->
+              forAll (index_value_pairs (length xs)) $ \ps ->
+              (V.fromList (xs :: [A]) V.// ps) ==? (xs // ps)
+prop_update = forAll arbitrary $ \xs ->
+              forAll (index_value_pairs (length xs)) $ \ps ->
+              (V.update (V.fromList (xs :: [A])) (V.fromList ps))
+                ==? (xs // ps)
+prop_backpermute = forAll arbitrary $ \xs ->
+                   forAll (indices (length xs)) $ \is ->
+                   V.backpermute (V.fromList (xs :: [A])) (V.fromList is)
+                     ==? map (xs!!) is
+prop_reverse = arg_ty [A] $ V.reverse ==? reverse
+
+prop_map = arg_ty (A :-> B) $ V.map ==? map
+prop_zipWith = arg_ty (A :-> B :-> C) $ V.zipWith ==? zipWith
+prop_zip     = arg_ty [A] $ arg2_ty [B] $ V.zip ==? zip
+
+prop_filter = arg_ty (A :-> Bool) $ V.filter ==? filter
+prop_takeWhile = arg_ty (A :-> Bool) $ V.takeWhile ==? takeWhile
+prop_dropWhile = arg_ty (A :-> Bool) $ V.dropWhile ==? dropWhile
+
+prop_elem      = arg_ty A $ V.elem ==? elem
+prop_notElem   = arg_ty A $ V.notElem ==? notElem
+prop_find      = arg_ty (A :-> Bool) $ V.find ==? find
+prop_findIndex = arg_ty (A :-> Bool) $ V.findIndex ==? findIndex
+
+prop_foldl     = arg_ty (A :-> B :-> A) V.foldl ==? foldl
+prop_foldl1    = arg2 (not . null) $
+                 arg_ty (A :-> A :-> A) V.foldl1 ==? foldl1
+prop_foldl'    = arg_ty (A :-> B :-> A) V.foldl' ==? foldl'
+prop_foldl1'   = arg2 (not . null) $
+                 arg_ty (A :-> A :-> A) V.foldl1' ==? foldl1'
+prop_foldr     = arg_ty (A :-> B :-> B) V.foldr ==? foldr
+prop_foldr1    = arg2 (not . null) $
+                 arg_ty (A :-> A :-> A) V.foldr1 ==? foldr1
+
+prop_prescanl  = arg_ty (A :-> B :-> A)
+                 V.prescanl ==? (\f z -> init . scanl f z)
+prop_prescanl' = arg_ty (A :-> B :-> A)
+                 V.prescanl' ==? (\f z -> init . scanl f z)
+prop_postscanl  = arg_ty (A :-> B :-> A)
+                  V.postscanl ==? (\f z -> tail . scanl f z)
+prop_postscanl' = arg_ty (A :-> B :-> A)
+                  V.postscanl' ==? (\f z -> tail . scanl f z)
+prop_scanl    = arg_ty (A :-> B :-> A)
+                V.scanl ==? scanl
+prop_scanl'   = arg_ty (A :-> B :-> A)
+                V.scanl' ==? scanl
+prop_scanl1   = arg2 (not . null) $
+                arg_ty (A :-> A :-> A)
+                V.scanl1 ==? scanl1
+prop_scanl1'  = arg2 (not . null) $
+                arg_ty (A :-> A :-> A)
+                V.scanl1' ==? scanl1
+
+
+tests = "vs. list" $$? [
+                      "convert"         $? prop_convert
+
+                    , "(==)"            $? prop_eq
+                    , "compare"         $? prop_compare
+
+                    , "length"          $? prop_length
+                    , "null"            $? prop_null
+
+                    , "empty"           $? prop_empty
+                    , "singleton"       $? prop_singleton
+                    , "replicate"       $? prop_replicate
+                    , "cons"            $? prop_cons
+                    , "snoc"            $? prop_snoc
+                    , "(++)"            $? prop_append
+                    , "copy"            $? prop_copy
+
+                    , "head"            $? prop_head
+                    , "last"            $? prop_last
+                    , "(!)"             $? prop_index
+
+                    , "slice"           $? prop_slice
+                    , "init"            $? prop_init
+                    , "tail"            $? prop_tail
+                    , "take"            $? prop_take
+                    , "drop"            $? prop_drop
+
+                    , "accum"           $? prop_accum
+                    , "(//)"            $? prop_upd
+                    , "update"          $? prop_update
+                    , "backpermute"     $? prop_backpermute
+                    , "reverse"         $? prop_reverse
+
+                    , "map"             $? prop_map
+                    , "zipWith"         $? prop_zipWith
+                    , "zip"             $? prop_zip
+
+                    , "filter"          $? prop_filter
+                    , "takeWhile"       $? prop_takeWhile
+                    , "dropWhile"       $? prop_dropWhile
+
+                    , "elem"            $? prop_elem
+                    , "notElem"         $? prop_notElem
+                    , "find"            $? prop_find
+                    , "findIndex"       $? prop_findIndex
+
+                    , "foldl"           $? prop_foldl
+                    , "foldl1"          $? prop_foldl1
+                    , "foldl'"          $? prop_foldl'
+                    , "foldl1'"         $? prop_foldl1'
+                    , "foldr"           $? prop_foldr
+                    , "foldr1"          $? prop_foldr1
+
+                    , "prescanl"        $? prop_prescanl
+                    , "prescanl'"       $? prop_prescanl'
+                    , "postscanl"       $? prop_postscanl
+                    , "postscanl'"      $? prop_postscanl'
+                    , "scanl"           $? prop_scanl
+                    , "scanl'"          $? prop_scanl'
+                    , "scanl1"          $? prop_scanl1
+                    , "scanl1'"         $? prop_scanl1'
+                    ]
+
diff --git a/testsuite/Testsuite/Vector/Errors.hs b/testsuite/Testsuite/Vector/Errors.hs
new file mode 100644 (file)
index 0000000..1e19bf1
--- /dev/null
@@ -0,0 +1,47 @@
+module Testsuite.Vector.Errors ( tests )
+where
+
+import           Data.Vector  ( Vector )
+import qualified Data.Vector as V
+
+import Testsuite.Utils.Test
+import Testsuite.Utils.Property
+import Test.QuickCheck.Batch
+
+prop_headOfEmpty = isBottom (V.head V.empty)
+prop_lastOfEmpty = isBottom (V.last V.empty)
+prop_indexNegative = isBottom (V.singleton 5 V.! (-1))
+prop_indexOutOfRange = isBottom (V.singleton 5 V.! 2)
+prop_sliceNegativeIndex = isBottom (V.slice V.empty (-1) 0)
+prop_sliceIndexOutOfRange = isBottom (V.slice (V.singleton 5) 2 1)
+prop_sliceNegativeLength = isBottom (V.slice V.empty 0 (-1))
+prop_sliceLengthOutOfRange = isBottom (V.slice (V.singleton 5) 0 2)
+prop_initOfEmpty = isBottom (V.init V.empty)
+prop_tailOfEmpty = isBottom (V.tail V.empty)
+prop_foldl1OfEmpty = isBottom (V.foldl1 (\_ _ -> ()) V.empty)
+prop_foldl1'OfEmpty = isBottom (V.foldl1' (\_ _ -> ()) V.empty)
+prop_foldr1OfEmpty  = isBottom (V.foldr1 (\_ _ -> ()) V.empty)
+prop_scanl1OfEmpty  = isBottom (V.scanl1 (\x _ -> x) V.empty)
+prop_scanl1'OfEmpty = isBottom (V.scanl1' (\x _ -> x) V.empty)
+
+
+tests = "errors" $$? [
+                      "head of empty"           $? prop_headOfEmpty
+                    , "last of empty"           $? prop_lastOfEmpty
+                    , "negative index"          $? prop_indexNegative
+                    , "index out of range"      $? prop_indexOutOfRange
+                    , "slice (negative index)"  $? prop_sliceNegativeIndex
+                    , "slice (index out of range)"
+                                                $? prop_sliceIndexOutOfRange
+                    , "slice (negative length)" $? prop_sliceNegativeLength
+                    , "slice (length out of range)"
+                                                $? prop_sliceLengthOutOfRange
+                    , "init of empty"           $? prop_initOfEmpty
+                    , "tail of empty"           $? prop_tailOfEmpty
+                    , "foldl1 of empty"         $? prop_foldl1OfEmpty
+                    , "foldl1' of empty"        $? prop_foldl1'OfEmpty
+                    , "foldr1 of empty"         $? prop_foldr1OfEmpty
+                    , "scanl1 of empty"         $? prop_scanl1OfEmpty
+                    , "scanl1' of empty"        $? prop_scanl1'OfEmpty
+                     ]
+