Commit 80e240f5 authored by jpbernardy's avatar jpbernardy
Browse files

[project @ 2006-01-01 21:46:31 by jpbernardy]

More tests for:
  * Sets
  * Non-structural equality
  * Left-Bias
  * Performance
parent bb1d70dc
......@@ -6,8 +6,13 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
generate: tools/instancesTestGen tools/soundnessTestGen
tools/soundnessTestGen reference/Map.hs templates/TestSoundMap.hs '["fromAscList","keysSet","lookup"]'
tools/instancesTestGen templates/Test*.hs
tools/soundnessTestGen reference/Map.hs templates/TestSoundMap.hs '["fromAscList","fromList","keysSet","lookup"]'
tools/soundnessTestGen reference/Set.hs templates/TestSoundSet.hs '["fromAscList","fromList"]'
tools/instancesTestGen templates/Test*.hs > "generated.T"
benchmark:
tools/instancesTestGen templates/Benchmark*.hs > "benchmark.T"
tools/soundnessTestGen: tools/SoundnessTestGen.hs
ghc --make $< -o $@
......@@ -21,6 +26,7 @@ tools/instancesTestGen: tools/InstancesTestGen.hs
veryclean: clean
-rm test_*
-rm *.T
clean:
-rm $(find . -name "*.o")
......
module Set where
import Prelude hiding (lookup, map, filter)
import qualified Data.List as L
import Data.Maybe
type Set a = [a]
-- with the additional invariant that an element cannot be present twice (using Eq equality)
-- NOTE: the list needs not to be sorted.
null :: Set a -> Bool
null = L.null
size :: Set a -> Int
size = L.length
member :: Ord a => a -> Set a -> Bool
member = L.elem
isSubsetOf :: Ord a => Set a -> Set a -> Bool
isSubsetOf s1 s2 = all (`member` s2) s1
isProperSubsetOf :: Ord a => Set a -> Set a -> Bool
isProperSubsetOf s1 s2 = size s1 < size s2 && isSubsetOf s1 s2
empty :: Set a
empty = []
singleton :: a -> Set a
singleton a = [a]
insert :: Eq a => a -> Set a -> Set a
insert x s = x:delete x s
delete :: Eq a => a -> Set a -> Set a
delete x s = L.filter (/= x) s
union :: Eq a => Set a -> Set a -> Set a
union s t = L.nub (s ++ t)
unions :: Eq a => [Set a] -> Set a
unions = foldl union []
difference :: Eq a => Set a -> Set a -> Set a
difference = (L.\\)
intersection :: Eq a => Set a -> Set a -> Set a
intersection = L.intersect
filter :: Eq a => (a -> Bool) -> Set a -> Set a
filter = L.filter
partition :: Eq a => (a -> Bool) -> Set a -> (Set a, Set a)
partition = L.partition
map :: (Eq a, Eq b) => (a -> b) -> Set a -> Set b
map f = L.nub . L.map f
elems :: Ord a => Set a -> [a]
elems = L.sort
toList :: Ord a => Set a -> [a]
toList = L.sort
fromList :: Eq a => [a] -> Set a
fromList = L.nub
toAscList :: Ord a => Set a -> [a]
toAscList = toList
fromAscList :: Eq a => [a] -> Set a
fromAscList = fromList
{-
: MAPMODULE : MAPK : KEY : EL :
------------------------------------------
: Data.Map : M.Map Int : Int : Int :
: Data.IntMap : M.IntMap : Int : Int :
-}
{-
TODO
* Have both ordered and random testData
-}
import System.Time
import System.CPUTime
import qualified MAPMODULE as M
import System.Environment
import System.Mem
import Data.List(foldl', transpose)
type MAP = MAPK EL
testData :: [KEY]
testData = [1..500000]
testPairs = zip testData testData
lookups :: MAP -> [KEY] -> IO ()
lookups table [] = return ()
lookups table (x:xs) = lk `seq` lookups table xs
where lk = M.lookup x table
lk :: Maybe EL
main = do
mapM_ (\a -> a `seq` return ()) testData
testMany ["Insertion", "Lookup", "Deletion"] $ do
t1 <- getCPUTime
let table = foldl' (\t a -> M.insert a a t) M.empty testData
table `seq` return ()
t1' <- getCPUTime
performGC
t2 <- getCPUTime
lookups table testData
t2' <- getCPUTime
performGC
t3 <- getCPUTime
let table' = foldl' (\t a -> M.delete a t) table testData in table' `seq` return ()
t3' <- getCPUTime
return [t1'-t1, t2'-t2, t3'-t3]
numberOfTests = 10
testMany :: [String] -> IO [Integer] -> IO ()
testMany names io = do
ts <- sequence [performGC >> io | _ <- [1..numberOfTests]]
let averages = map (`div` numberOfTests) $ map sum $ transpose ts
putStrLn fileName
mapM_ showTime $ zip names averages
showTime (name, time::Integer) = do
putStrLn $ name ++ " time " ++ show (fromIntegral time/(10^^12))
......@@ -3,10 +3,11 @@
Test instanciations.
: SETMODULE : SET : EL :
--------------------------------------
: Data.Set : S.Set Int : Int :
: Data.IntSet : S.IntSet : Int :
: SETMODULE : SET : EL :
----------------------------------------
: Data.Set : S.Set Int : Int :
: Data.Set : S.Set Nasty : Nasty :
: Data.IntSet : S.IntSet : Int :
-}
......@@ -54,17 +55,15 @@ prop_UnionComm t1 t2
prop_Diff :: [EL] -> [EL] -> Bool
prop_Diff xs ys
= S.toAscList (S.difference (S.fromList xs) (S.fromList ys))
== List.sort ((List.\\) (List.nub xs) (List.nub ys))
== List.sort ((List.\\) (List.nub xs) (List.nub ys))
prop_Int :: [EL] -> [EL] -> Bool
prop_Int xs ys
= S.toAscList (S.intersection (S.fromList xs) (S.fromList ys))
== List.sort (List.nub ((List.intersect) (xs) (ys)))
prop_Ordered
= forAll (choose (5,100)) $ \n ->
let xs = [0..n::EL]
in S.fromAscList xs == S.fromList xs
prop_Ordered :: [EL] -> Bool
prop_Ordered xs = S.fromAscList (List.sort xs) == S.fromList xs
prop_toAscList :: [EL] -> Bool
prop_toAscList xs
......
......@@ -3,9 +3,11 @@
Test instanciations.
: REFMODULE : TESTMODULE : K : A :
---------------------------------------
: Map : Data.Map : Int : Int :
: REFMODULE : TESTMODULE : TESTCOLL : K : A :
-----------------------------------------------------------
: Map : Data.Map : L.Map Int Int : Int : Int :
: Map : Data.Map : L.Map Nasty Int : Nasty : Int :
: Map : Data.IntMap : L.IntMap Int : Int : Int :
-}
......@@ -31,27 +33,34 @@ testing f = \x y -> f x == f y
rIn :: REFCOLL -> REFCOLL
rIn = List.nubBy (testing fst)
lIn :: REFCOLL -> L.Map K A
lIn :: REFCOLL -> TESTCOLL
lIn = L.fromList . rIn
rOut :: REFCOLL -> REFCOLL
rOut = List.sortBy (comparing fst)
lOut :: L.Map K A -> REFCOLL
lOut :: TESTCOLL -> REFCOLL
lOut = L.toAscList
main = runTests fileName propNames propTests
--FIXME: better test functions are in order. (non-commutative stuff, things really depending on arguments, etc.)
class TestSet k a where
k_a_a :: k -> a -> a
instance TestSet Int Int where
k_a_a k a = k+a
instance TestSet Nasty Int where
k_a_a k a = nastyKey k+a
a_a_a = (+)
k_a_a_a k = a_a_a
a_a = (+1)
k_a_a k a = a+k
a_maybe_a a = if even a then Nothing else Just a
k_a_maybe_a k = a_maybe_a
......@@ -70,167 +79,172 @@ k_a_b_c = k_a_a_a
-- !!! EVERYTHING BELOW THIS LINE WILL BE DELETED !!! --
prop_null :: REFCOLL -> Bool
prop_null refcol1
= (==) (L.null (lIn refcol1)) (R.null (rIn refcol1))
prop_null refcoll1
= structEq (L.null (lIn refcoll1)) (R.null (rIn refcoll1))
prop_size :: REFCOLL -> Bool
prop_size refcol1
= (==) (L.size (lIn refcol1)) (R.size (rIn refcol1))
prop_size refcoll1
= structEq (L.size (lIn refcoll1)) (R.size (rIn refcoll1))
prop_member :: K -> REFCOLL -> Bool
prop_member k1 refcol2
= (==) (L.member k1 (lIn refcol2)) (R.member k1 (rIn refcol2))
prop_member k1 refcoll2
= structEq (L.member k1 (lIn refcoll2))
(R.member k1 (rIn refcoll2))
prop_findWithDefault :: A -> K -> REFCOLL -> Bool
prop_findWithDefault a1 k2 refcol3
= (==) (L.findWithDefault a1 k2 (lIn refcol3))
(R.findWithDefault a1 k2 (rIn refcol3))
prop_findWithDefault a1 k2 refcoll3
= structEq (L.findWithDefault a1 k2 (lIn refcoll3))
(R.findWithDefault a1 k2 (rIn refcoll3))
prop_empty :: Bool
prop_empty = (==) (lOut L.empty) (rOut R.empty)
prop_empty = structEq (lOut L.empty) (rOut R.empty)
prop_singleton :: K -> A -> Bool
prop_singleton k1 a2
= (==) (lOut (L.singleton k1 a2)) (rOut (R.singleton k1 a2))
= structEq (lOut (L.singleton k1 a2)) (rOut (R.singleton k1 a2))
prop_insert :: K -> A -> REFCOLL -> Bool
prop_insert k1 a2 refcol3
= (==) (lOut (L.insert k1 a2 (lIn refcol3)))
(rOut (R.insert k1 a2 (rIn refcol3)))
prop_insert k1 a2 refcoll3
= structEq (lOut (L.insert k1 a2 (lIn refcoll3)))
(rOut (R.insert k1 a2 (rIn refcoll3)))
prop_insertWith :: K -> A -> REFCOLL -> Bool
prop_insertWith k1 a2 refcol3
= (==) (lOut (L.insertWith a_a_a k1 a2 (lIn refcol3)))
(rOut (R.insertWith a_a_a k1 a2 (rIn refcol3)))
prop_insertWith k1 a2 refcoll3
= structEq (lOut (L.insertWith a_a_a k1 a2 (lIn refcoll3)))
(rOut (R.insertWith a_a_a k1 a2 (rIn refcoll3)))
prop_insertWithKey :: K -> A -> REFCOLL -> Bool
prop_insertWithKey k1 a2 refcol3
= (==) (lOut (L.insertWithKey k_a_a_a k1 a2 (lIn refcol3)))
(rOut (R.insertWithKey k_a_a_a k1 a2 (rIn refcol3)))
prop_insertWithKey k1 a2 refcoll3
= structEq (lOut (L.insertWithKey k_a_a_a k1 a2 (lIn refcoll3)))
(rOut (R.insertWithKey k_a_a_a k1 a2 (rIn refcoll3)))
prop_insertLookupWithKey :: K -> A -> REFCOLL -> Bool
prop_insertLookupWithKey k1 a2 refcol3
= (==)
prop_insertLookupWithKey k1 a2 refcoll3
= structEq
(let (maybe_a4, map_k_a5)
= L.insertLookupWithKey k_a_a_a k1 a2 (lIn refcol3)
= L.insertLookupWithKey k_a_a_a k1 a2 (lIn refcoll3)
in (maybe_a4, lOut map_k_a5))
(let (maybe_a4, map_k_a5)
= R.insertLookupWithKey k_a_a_a k1 a2 (rIn refcol3)
= R.insertLookupWithKey k_a_a_a k1 a2 (rIn refcoll3)
in (maybe_a4, rOut map_k_a5))
prop_delete :: K -> REFCOLL -> Bool
prop_delete k1 refcol2
= (==) (lOut (L.delete k1 (lIn refcol2)))
(rOut (R.delete k1 (rIn refcol2)))
prop_delete k1 refcoll2
= structEq (lOut (L.delete k1 (lIn refcoll2)))
(rOut (R.delete k1 (rIn refcoll2)))
prop_adjust :: K -> REFCOLL -> Bool
prop_adjust k1 refcol2
= (==) (lOut (L.adjust a_a k1 (lIn refcol2)))
(rOut (R.adjust a_a k1 (rIn refcol2)))
prop_adjust k1 refcoll2
= structEq (lOut (L.adjust a_a k1 (lIn refcoll2)))
(rOut (R.adjust a_a k1 (rIn refcoll2)))
prop_adjustWithKey :: K -> REFCOLL -> Bool
prop_adjustWithKey k1 refcol2
= (==) (lOut (L.adjustWithKey k_a_a k1 (lIn refcol2)))
(rOut (R.adjustWithKey k_a_a k1 (rIn refcol2)))
prop_adjustWithKey k1 refcoll2
= structEq (lOut (L.adjustWithKey k_a_a k1 (lIn refcoll2)))
(rOut (R.adjustWithKey k_a_a k1 (rIn refcoll2)))
prop_update :: K -> REFCOLL -> Bool
prop_update k1 refcol2
= (==) (lOut (L.update a_maybe_a k1 (lIn refcol2)))
(rOut (R.update a_maybe_a k1 (rIn refcol2)))
prop_update k1 refcoll2
= structEq (lOut (L.update a_maybe_a k1 (lIn refcoll2)))
(rOut (R.update a_maybe_a k1 (rIn refcoll2)))
prop_updateWithKey :: K -> REFCOLL -> Bool
prop_updateWithKey k1 refcol2
= (==) (lOut (L.updateWithKey k_a_maybe_a k1 (lIn refcol2)))
(rOut (R.updateWithKey k_a_maybe_a k1 (rIn refcol2)))
prop_updateWithKey k1 refcoll2
= structEq (lOut (L.updateWithKey k_a_maybe_a k1 (lIn refcoll2)))
(rOut (R.updateWithKey k_a_maybe_a k1 (rIn refcoll2)))
prop_updateLookupWithKey :: K -> REFCOLL -> Bool
prop_updateLookupWithKey k1 refcol2
= (==)
prop_updateLookupWithKey k1 refcoll2
= structEq
(let (maybe_a3, map_k_a4)
= L.updateLookupWithKey k_a_maybe_a k1 (lIn refcol2)
= L.updateLookupWithKey k_a_maybe_a k1 (lIn refcoll2)
in (maybe_a3, lOut map_k_a4))
(let (maybe_a3, map_k_a4)
= R.updateLookupWithKey k_a_maybe_a k1 (rIn refcol2)
= R.updateLookupWithKey k_a_maybe_a k1 (rIn refcoll2)
in (maybe_a3, rOut map_k_a4))
prop_union :: REFCOLL -> REFCOLL -> Bool
prop_union refcol1 refcol2
= (==) (lOut (L.union (lIn refcol1) (lIn refcol2)))
(rOut (R.union (rIn refcol1) (rIn refcol2)))
prop_union refcoll1 refcoll2
= structEq (lOut (L.union (lIn refcoll1) (lIn refcoll2)))
(rOut (R.union (rIn refcoll1) (rIn refcoll2)))
prop_unionWith :: REFCOLL -> REFCOLL -> Bool
prop_unionWith refcol1 refcol2
= (==) (lOut (L.unionWith a_a_a (lIn refcol1) (lIn refcol2)))
(rOut (R.unionWith a_a_a (rIn refcol1) (rIn refcol2)))
prop_unionWith refcoll1 refcoll2
= structEq (lOut (L.unionWith a_a_a (lIn refcoll1) (lIn refcoll2)))
(rOut (R.unionWith a_a_a (rIn refcoll1) (rIn refcoll2)))
prop_unionWithKey :: REFCOLL -> REFCOLL -> Bool
prop_unionWithKey refcol1 refcol2
= (==) (lOut (L.unionWithKey k_a_a_a (lIn refcol1) (lIn refcol2)))
(rOut (R.unionWithKey k_a_a_a (rIn refcol1) (rIn refcol2)))
prop_unionWithKey refcoll1 refcoll2
= structEq
(lOut (L.unionWithKey k_a_a_a (lIn refcoll1) (lIn refcoll2)))
(rOut (R.unionWithKey k_a_a_a (rIn refcoll1) (rIn refcoll2)))
prop_unions :: [REFCOLL] -> Bool
prop_unions refcol1
= (==) (lOut (L.unions (fmap lIn refcol1)))
(rOut (R.unions (fmap rIn refcol1)))
prop_unions refcoll1
= structEq (lOut (L.unions (fmap lIn refcoll1)))
(rOut (R.unions (fmap rIn refcoll1)))
prop_unionsWith :: [REFCOLL] -> Bool
prop_unionsWith refcol1
= (==) (lOut (L.unionsWith a_a_a (fmap lIn refcol1)))
(rOut (R.unionsWith a_a_a (fmap rIn refcol1)))
prop_unionsWith refcoll1
= structEq (lOut (L.unionsWith a_a_a (fmap lIn refcoll1)))
(rOut (R.unionsWith a_a_a (fmap rIn refcoll1)))
prop_difference :: REFCOLL -> REFCOLL -> Bool
prop_difference refcol1 refcol2
= (==) (lOut (L.difference (lIn refcol1) (lIn refcol2)))
(rOut (R.difference (rIn refcol1) (rIn refcol2)))
prop_difference refcoll1 refcoll2
= structEq (lOut (L.difference (lIn refcoll1) (lIn refcoll2)))
(rOut (R.difference (rIn refcoll1) (rIn refcoll2)))
prop_differenceWith :: REFCOLL -> REFCOLL -> Bool
prop_differenceWith refcol1 refcol2
= (==)
(lOut (L.differenceWith a_b_maybe_a (lIn refcol1) (lIn refcol2)))
(rOut (R.differenceWith a_b_maybe_a (rIn refcol1) (rIn refcol2)))
prop_differenceWith refcoll1 refcoll2
= structEq
(lOut (L.differenceWith a_b_maybe_a (lIn refcoll1) (lIn refcoll2)))
(rOut (R.differenceWith a_b_maybe_a (rIn refcoll1) (rIn refcoll2)))
prop_differenceWithKey :: REFCOLL -> REFCOLL -> Bool
prop_differenceWithKey refcol1 refcol2
= (==)
prop_differenceWithKey refcoll1 refcoll2
= structEq
(lOut
(L.differenceWithKey k_a_b_maybe_a (lIn refcol1) (lIn refcol2)))
(L.differenceWithKey k_a_b_maybe_a (lIn refcoll1) (lIn refcoll2)))
(rOut
(R.differenceWithKey k_a_b_maybe_a (rIn refcol1) (rIn refcol2)))
(R.differenceWithKey k_a_b_maybe_a (rIn refcoll1) (rIn refcoll2)))
prop_intersection :: REFCOLL -> REFCOLL -> Bool
prop_intersection refcol1 refcol2
= (==) (lOut (L.intersection (lIn refcol1) (lIn refcol2)))
(rOut (R.intersection (rIn refcol1) (rIn refcol2)))
prop_intersection refcoll1 refcoll2
= structEq (lOut (L.intersection (lIn refcoll1) (lIn refcoll2)))
(rOut (R.intersection (rIn refcoll1) (rIn refcoll2)))
prop_intersectionWith :: REFCOLL -> REFCOLL -> Bool
prop_intersectionWith refcol1 refcol2
= (==)
(lOut (L.intersectionWith a_b_c (lIn refcol1) (lIn refcol2)))
(rOut (R.intersectionWith a_b_c (rIn refcol1) (rIn refcol2)))
prop_intersectionWith refcoll1 refcoll2
= structEq
(lOut (L.intersectionWith a_b_c (lIn refcoll1) (lIn refcoll2)))
(rOut (R.intersectionWith a_b_c (rIn refcoll1) (rIn refcoll2)))
prop_intersectionWithKey :: REFCOLL -> REFCOLL -> Bool
prop_intersectionWithKey refcol1 refcol2
= (==)
(lOut (L.intersectionWithKey k_a_b_c (lIn refcol1) (lIn refcol2)))
(rOut (R.intersectionWithKey k_a_b_c (rIn refcol1) (rIn refcol2)))
prop_intersectionWithKey refcoll1 refcoll2
= structEq
(lOut
(L.intersectionWithKey k_a_b_c (lIn refcoll1) (lIn refcoll2)))
(rOut
(R.intersectionWithKey k_a_b_c (rIn refcoll1) (rIn refcoll2)))
prop_mapWithKey :: REFCOLL -> Bool
prop_mapWithKey refcol1
= (==) (lOut (L.mapWithKey k_a_b (lIn refcol1)))
(rOut (R.mapWithKey k_a_b (rIn refcol1)))
prop_mapWithKey refcoll1
= structEq (lOut (L.mapWithKey k_a_b (lIn refcoll1)))
(rOut (R.mapWithKey k_a_b (rIn refcoll1)))
prop_elems :: REFCOLL -> Bool
prop_elems refcol1
= (==) (L.elems (lIn refcol1)) (R.elems (rIn refcol1))
prop_elems refcoll1
= structEq (L.elems (lIn refcoll1)) (R.elems (rIn refcoll1))
prop_keys :: REFCOLL -> Bool
prop_keys refcol1
= (==) (L.keys (lIn refcol1)) (R.keys (rIn refcol1))
prop_keys refcoll1
= structEq (L.keys (lIn refcoll1)) (R.keys (rIn refcoll1))
prop_assocs :: REFCOLL -> Bool
prop_assocs refcol1
= (==) (L.assocs (lIn refcol1)) (R.assocs (rIn refcol1))
prop_assocs refcoll1
= structEq (L.assocs (lIn refcoll1)) (R.assocs (rIn refcoll1))
prop_toAscList :: REFCOLL -> Bool
prop_toAscList refcol1
= (==) (L.toAscList (lIn refcol1)) (R.toAscList (rIn refcol1))
prop_toAscList refcoll1
= structEq (L.toAscList (lIn refcoll1))
(R.toAscList (rIn refcoll1))
{-
Test instanciations.
: REFMODULE : TESTMODULE : TESTCOLL : A :
-----------------------------------------------
: Set : Data.Set : L.Set Int : Int :
: Set : Data.Set : L.Set Nasty : Nasty :
: Set : Data.IntSet : L.IntSet : Int :
-}
-- Module to test the interface of Set-like types.
import qualified REFMODULE as R
import qualified TESTMODULE as L
import LibTest
import Control.Monad
import Data.List as List
type REFCOLL = [A]
comparing f = \x y -> f x `compare` f y
testing f = \x y -> f x == f y
rIn :: REFCOLL -> REFCOLL
rIn = List.nub
lIn :: REFCOLL -> TESTCOLL
lIn = L.fromList . rIn
rOut :: REFCOLL -> REFCOLL
rOut = List.sort
lOut :: TESTCOLL -> REFCOLL
lOut = L.toAscList
main = runTests fileName propNames propTests
--FIXME: better test functions are in order. (non-commutative stuff, things really depending on arguments, etc.)
class TestSet a where
a_bool :: a -> Bool
a_a :: a -> a
a_a_a :: a -> a -> a