Commits

Gideon Sireling  committed e427855

test pure helpers

  • Participants
  • Parent commits 52ae041

Comments (0)

Files changed (2)

File binding-core/tests/HUnit.hs

+{-# LANGUAGE TupleSections #-}
 import Test.HUnit
 
 import Control.Monad
 import System.Random
 
 import Binding.List as B
+import Prelude as P
 
 -- Change these to exercise different variable and data types
 type V = IORef
-type A = Char
+type A = Int
+
+-- *** Test pure helpers ***
+
+-- | Generate a list for testing
+-- Many operations are expected to fail on lists of less than 2 elements
+list' :: IO ([A], Int)
+list' = do size <- randomRIO (2,100)
+           list <- replicateM size randomIO
+           return (list, size)
+
+testRemove' :: Assertion
+testRemove' = do (list, size) <- list'
+                 pos <- randomRIO (0, size-2)
+                 let actual = remove' list pos
+                 assertEqual "List hasn't shrunk correctly" (size-1) (P.length actual)
+                 assertEqual "Head of list incorrect" (take pos list) (take pos actual)
+                 assertEqual "Tail of list incorrect" (drop (pos+1) list) (drop pos actual)
+
+testRemoveLast' :: Assertion
+testRemoveLast' = do (list, size) <- list'
+                     let actual = remove' list (size-1)
+                     assertEqual "List hasn't shrunk correctly" (size-1) (P.length actual)
+                     assertEqual "List is incorrect" (take (size-1) list) actual
+
+testInsert' :: Assertion
+testInsert' = do (list, size) <- list'
+                 pos <- randomRIO (0, size-1)
+                 new <- randomIO
+                 let actual = insert' list pos new
+                 assertEqual "List hasn't shrunk correctly" (size+1) (P.length actual)
+                 assertEqual "Head of list incorrect" (take pos list) (take pos actual)
+                 assertEqual "Element not inserted" new (actual !! pos)
+                 assertEqual "Tail of list incorrect" (drop pos list) (drop (pos+1) actual)
+
+--- *** Test monadic functions ***
 
 testSource :: Assertion
 testSource = do --bind a source
              assertEqual "Value Changed" expected actual
 
 -- | Generate a 'BindingList' for testing
--- Many operations are expected to fail on list of less than 2 elements
 list :: IO ([A], Int, BindingList V A)
-list = do size <- randomRIO (2,100)
-          list <- replicateM size randomIO :: IO [A]
-          bl <- toBindingList list
-          return (list, size,bl)
+list = do (list, size) <- list'
+          liftM (list, size,) (toBindingList list)
 
 -- | Assert that a 'BindingList' holds the expected list
 assertList :: [A] -> BindingList V A -> Assertion
               ,"seekBy" ~: testSeekBy
               ,"next" ~: testNext
               ,"prev" ~: testPrev
+              ,"remove'" ~: testRemove'
               ,"remove" ~: testRemove
+              ,"remove' last" ~: testRemoveLast'
               ,"remove last" ~: testRemoveLast
+              ,"insert'" ~: testInsert'
               ,"insert" ~: testInsert]
           when (e>0 || f>0) exitFailure

File binding-core/tests/QuickCheck.hs

 type V = IORef
 type A = Char
 
+-- *** Helpers to generate random lists and positions ***
+
 -- | A random list with at least two elements
 newtype List = List [A] deriving Show
 
     arbitrary = liftM List $ choose (2, 100) >>= vector
     shrink (List xs) = [List ys | ys <- shrink xs, P.length ys > 1]
 
--- | Maps @x@ to the range [0..@max@]
-clamp :: Int -> Int -> Int
-clamp x max = if max == 0 then 0 else x `mod` max
-
--- | Maps @i@ to a position in @xs@, up to @1 - o@ from the end
-pos' :: Int -> Int -> [A] -> Int
-pos' o i xs = clamp i (P.length xs - o)
-
--- | Anywhere in the list
-anywhere = pos' 1
+-- | Maps @i@ to a position in @xs@
+anywhere :: Int -> [A] -> Int
+anywhere i xs = let max = P.length xs - 1
+                in if max == 0 then 0 else i `mod` max
 
 -- | Anywhere in the list except the last element
-notLast = pos' 2
+notLast :: Int -> [A] -> Int
+notLast i = anywhere i . tail
 
 -- | Create a 'BindingList', and 'seek' to @pos@
 list :: [A] -> Int -> IO (BindingList V A)
                  seek bl pos
                  return bl
 
+-- *** Test pure functions ***
+
+prop_remove' :: [A] -> Int -> Bool
+prop_remove' xs i = let pos = anywhere i xs
+                        actual = remove' xs pos
+                    in P.length actual == P.length xs - 1
+                    && take pos actual == take pos xs
+                    && drop (pos+1) xs == drop pos actual
+
+prop_removeLast' :: [A] -> Bool
+prop_removeLast' xs = let pos = P.length xs - 1
+                          actual = remove' xs pos
+                      in P.length actual == pos
+                      && actual == take pos xs
+
+prop_insert' :: [A] -> Int -> A -> Bool
+prop_insert' xs i x = let pos = anywhere i xs
+                          actual = insert' xs pos x
+                      in P.length actual == P.length xs + 1
+                      && take pos actual == take pos xs
+                      && actual !! pos == x
+                      && drop pos actual == drop (pos+1) xs
+
 -- *** QuickCheck 'Property's for Monadic actions. ***
 
 prop_Source :: (A,A,A) -> Property