Commit bb1d70dc authored by jpbernardy's avatar jpbernardy
Browse files

[project @ 2005-12-26 19:54:32 by jpbernardy]

Infrastructure for testing Data structures.
 + some tests
parent cb9fe768
...@@ -537,6 +537,23 @@ def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ): ...@@ -537,6 +537,23 @@ def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ):
# we don't check the compiler's stderr for a compile-and-run test # we don't check the compiler's stderr for a compile-and-run test
return simple_run( name, way, './'+name, testopts.extra_run_opts, 0 ) return simple_run( name, way, './'+name, testopts.extra_run_opts, 0 )
def multimod_compile_and_run_ignore_output( name, way, top_mod, extra_hc_opts ):
pretest_cleanup(name)
if way == 'ghci': # interpreted...
# not supported: exit code is too difficult to check.
return 'pass'
elif way == 'extcore' or way == 'optextcore' :
return extcore_run( name, way, extra_hc_opts, 0, top_mod )
else: # compiled...
result = simple_build( name, way, extra_hc_opts, 0, top_mod, 1 )
if result != 0:
return 'fail'
# we don't check the compiler's stderr for a compile-and-run test
return simple_run( name, way, './'+name, testopts.extra_run_opts, 1 )
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------
# Build a single-module program # Build a single-module program
......
TOP=../../..
all :: generate
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: tools/SoundnessTestGen.hs
ghc --make $< -o $@
tools/instancesTestGen: tools/InstancesTestGen.hs
ghc --make $< -o $@
%.test : test_%.hs LibTest.hs
$(TARGET_HC) --make -O -fglasgow-exts -package QuickCheck -o $@ $<
veryclean: clean
-rm test_*
clean:
-rm $(find . -name "*.o")
-rm $(find . -name "*.hi")
distclean: veryclean
-rm *~
\ No newline at end of file
module Map where
import Prelude hiding (lookup, map)
import qualified Data.List as L
import Data.Maybe
type Map k a = [(k,a)]
type Set k = [k]
-- * utilities
withoutKey op f = op (\k x -> f x)
withoutKey2 op f = op (\k x y -> f x y)
comparing f = \x y -> f x `compare` f y
testing f = \x y -> f x == f y
-- * Operators
(!) k = fromJust . lookup k
--TODO (\\)
-- * Query
null :: Map k a -> Bool
null = L.null
size :: Map k a -> Int
size = L.length
member :: Ord k => k -> Map k a -> Bool
member k l = k `L.elem` keys l
lookup :: (Monad m, Ord k) => k -> Map k a -> m a
lookup k l = do (_,x) <- lookupAssoc k l
return x
--lookupAssoc :: (Monad m, Ord k) => k -> Map k a -> m (k,a)
lookupAssoc k l = if L.null result then fail "Key not found" else return (head result)
where result = [x | x <- l, fst x == k]
findWithDefault :: Ord k => a -> k -> Map k a -> a
findWithDefault a k = fromMaybe a . lookup k
-- * Construction
empty :: Map k a
empty = []
singleton :: k -> a -> Map k a
singleton k a = [(k,a)]
-- ** Insertion
insert :: Ord k => k -> a -> Map k a -> Map k a
insert = insertWith const
insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith f k x m = insertWithKey (\k x y -> f x y) k x m
insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey f k x m = snd (insertLookupWithKey f k x m)
insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
insertLookupWithKey f k x m = (lookup k m, (k,x''):delete k m)
where x'' = fromMaybe x $ fmap (\x' -> f k x x') (lookup k m)
-- ** Delete\/Update
delete :: Ord k => k -> Map k a -> Map k a
delete k = filter (\x->fst x /= k)
adjust :: Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust = withoutKey adjustWithKey
adjustWithKey :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey f k = L.map (\(k',x') -> (k',if k' == k then f k' x' else x'))
update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
update = withoutKey updateWithKey
updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey f k m = maybeToList (newElem) ++ delete k m
where newElem = do (k',x') <- lookupAssoc k m
x'' <- f k' x'
return (k',x'')
updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
updateLookupWithKey f k m = (lookup k m, updateWithKey f k m)
-- * Combine
-- ** Union
union :: Ord k => Map k a -> Map k a -> Map k a
union = unionWith const
unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith = withoutKey2 unionWithKey
unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey f m1 m2 = L.map coalese $ L.groupBy (testing fst) $ L.sortBy (comparing fst) (m1 ++ m2)
where coalese group = let key = fst (head group) in (key, foldl1 (f key) (L.map snd group))
--coalese :: [(k,a)] -> (k,a)
unions :: Ord k => [Map k a] -> Map k a
unions = unionsWith const
unionsWith :: Ord k => (a -> a -> a) -> [Map k a] -> Map k a
unionsWith f = foldl (unionWith f) empty
difference :: Ord k => Map k a -> Map k b -> Map k a
difference = differenceWith (\_ _ -> Nothing)
differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWith = withoutKey2 differenceWithKey
differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWithKey f m1 m2 = catMaybes $ L.map newElem m1
where newElem (k,x) = do x <- case lookup k m2 of
Nothing -> Just x
Just y -> f k x y
return (k,x)
-- ** Intersection
intersection :: Ord k => Map k a -> Map k b -> Map k a
intersection = intersectionWith const
intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWith = withoutKey2 intersectionWithKey
intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey f m1 m2 = [(k,f k x y) | (k,x) <- m1, (k',y) <- m2, k == k']
-- * Traversal
-- ** Map
-- TODO map =
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
mapWithKey f m = [(k, f k x) | (k,x) <- m]
-- TODO mapAccum
-- TODO mapAccumWithKey
-- TODO mapKeys
-- TODO , mapKeys
-- TODO , mapKeysWith
-- TODO , mapKeysMonotonic
-- ** Fold
-- TODO fold
-- TODO foldWithKey
-- * Conversion
elems :: Ord k => Map k a -> [a]
elems = L.map snd . L.sortBy (comparing fst)
keys :: Ord k => Map k a -> [k]
keys = L.sort . L.map fst
keysSet :: Ord k => Map k a -> Set k
keysSet = keys
assocs :: Ord k => Map k a -> [(k, a)]
assocs = L.sortBy (comparing fst)
-- ** Lists
-- TODO toList
-- TODO fromList
-- TODO fromListWith
-- TODO fromListWithKey
-- ** Ordered lists
toAscList :: Ord k => Map k a -> [(k, a)]
toAscList = L.sortBy (comparing fst)
fromAscList :: Eq k => [(k, a)] -> Map k a
fromAscList = L.nubBy (testing fst)
-- TODO fromAscListWith
-- TODO fromAscListWithKey
-- TODO fromDistinctAscList
-- * Filter
-- TODO filter
-- TODO filterWithKey
-- TODO partition
-- TODO partitionWithKey
-- TODO split
-- TODO splitLookup
-- * Submap
-- TODO isSubmapOf, isSubmapOfBy
-- TODO isProperSubmapOf, isProperSubmapOfBy
-- * Indexed
-- TODO lookupIndex
-- TODO findIndex
-- TODO elemAt
-- TODO updateAt
-- TODO deleteAt
-- * Min\/Max
-- TODO findMin
-- TODO findMax
-- TODO deleteMin
-- TODO deleteMax
-- TODO deleteFindMin
-- TODO deleteFindMax
-- TODO updateMin
-- TODO updateMax
-- TODO updateMinWithKey
-- TODO updateMaxWithKey
-- * Debugging
{-
Test instanciations.
: MODULE : COLL : ELEM :
----------------------------------------------
: Data.Map : C.Map Int Int : (Int,Int) :
: Data.IntMap : C.IntMap Int : (Int,Int) :
: Data.Set : C.Set Int : (Int) :
: Data.IntSet : C.IntSet : (Int) :
-}
-- Module to test the interface of Map-like types.
-- These are all
-- black-box testing: we never check the internal data structures.
-- We are thus independant of the underlying representation.
import qualified MODULE as C
import qualified Data.List as List
import LibTest
import Control.Monad
main = runTests fileName propNames propTests
-------------------
-- Arbitrary maps
instance Arbitrary (COLL) where
arbitrary = return C.fromList `ap` arbitrary
prop_UnionAssoc :: COLL -> COLL -> COLL -> Bool
prop_UnionAssoc t1 t2 t3
= C.union t1 (C.union t2 t3) == C.union (C.union t1 t2) t3
{-
Test instanciations.
: MAPMODULE : MAPK : KEY : EL :
------------------------------------------
: Data.Map : M.Map Int : Int : Int :
: Data.IntMap : M.IntMap : Int : Int :
-}
-- Module to test the interface of Map-like types.
-- These are all
-- black-box testing: we never check the internal data structures.
-- We are thus independant of the underlying representation.
import qualified MAPMODULE as M
import qualified Data.List as List
import LibTest
import Control.Monad
type MAP = MAPK EL
main = runTests fileName propNames propTests
-------------------
-- Arbitrary maps
instance Arbitrary MAP where
arbitrary = return M.fromList `ap` arbitrary
prop_Split :: MAP -> KEY -> Bool
prop_Split s k = all (< k) (M.keys l) && all (> k) (M.keys r)
where (l,r) = M.split k s
prop_SplitUnion :: MAP -> KEY -> Property
prop_SplitUnion s k = not (M.member k s) ==> M.union l r == s
where (l,r) = M.split k s
prop_SplitLookup :: MAP -> KEY -> Bool
prop_SplitLookup s k = all (< k) (M.keys l) && all (> k) (M.keys r) && found == M.lookup k s
where (l,found,r) = M.splitLookup k s
prop_Single :: KEY -> EL -> Bool
prop_Single k x
= (M.insert k x M.empty == M.singleton k x)
prop_InsertDelete :: KEY -> EL -> MAP -> Property
prop_InsertDelete k x t
= (M.lookup k t == Nothing) ==> M.delete k (M.insert k x t) == t
prop_UnionInsert :: KEY -> EL -> MAP -> Bool
prop_UnionInsert k x t
= M.union (M.singleton k x) t == M.insert k x t
prop_UnionAssoc :: MAP -> MAP -> MAP -> Bool
prop_UnionAssoc t1 t2 t3
= M.union t1 (M.union t2 t3) == M.union (M.union t1 t2) t3
prop_UnionComm :: MAP -> MAP -> Bool
prop_UnionComm t1 t2
= (M.union t1 t2 == M.unionWith (\x y -> y) t2 t1)
prop_UnionWith :: [(KEY,EL)] -> [(KEY,EL)] -> Bool
prop_UnionWith xs ys
= sum (M.elems (M.unionWith (+) (M.fromListWith (+) xs) (M.fromListWith (+) ys)))
== (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
prop_Diff :: [(KEY,EL)] -> [(KEY,EL)] -> Bool
prop_Diff xs ys
= List.sort (M.keys (M.difference (M.fromListWith (+) xs) (M.fromListWith (+) ys)))
== List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys)))
prop_Int :: [(KEY,EL)] -> [(KEY,EL)] -> Bool
prop_Int xs ys
= List.sort (M.keys (M.intersection (M.fromListWith (+) xs) (M.fromListWith (+) ys)))
== List.sort (List.nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
prop_Ordered
= forAll (choose (5,100)) $ \n ->
let xs = [(x,()) | x <- [0..n::Int]]
in M.fromAscList xs == M.fromList xs
prop_toAscList :: [KEY] -> Bool
prop_toAscList xs
= (List.sort $ List.nub $ xs) == (map fst $ M.toAscList $ M.fromList $ zip xs (repeat ()))
prop_toList :: [KEY] -> Bool
prop_toList xs
= (List.sort $ List.nub $ xs) == (map fst $ M.toList $ M.fromList $ zip xs (repeat ()))
{-
Test instanciations.
: SETMODULE : SET : EL :
--------------------------------------
: Data.Set : S.Set Int : Int :
: Data.IntSet : S.IntSet : Int :
-}
import qualified SETMODULE as S
import LibTest
import Control.Monad
import qualified Data.List as List
main = runTests fileName propNames propTests
instance Arbitrary (SET) where
arbitrary = return S.fromList `ap` arbitrary
prop_Split :: SET -> EL -> Bool
prop_Split s k = all (< k) (S.elems l) && all (> k) (S.elems r)
where (l,r) = S.split k s
prop_SplitUnion :: SET -> EL -> Property
prop_SplitUnion s k = not (S.member k s) ==> S.union l r == s
where (l,r) = S.split k s
prop_SplitMember :: SET -> EL -> Bool
prop_SplitMember s k = all (< k) (S.elems l) && all (> k) (S.elems r) && found == S.member k s
where (l,found,r) = S.splitMember k s
prop_Single :: EL -> Bool
prop_Single x
= (S.insert x S.empty == S.singleton x)
prop_InsertDelete :: EL -> SET -> Property
prop_InsertDelete k t
= not (S.member k t) ==> S.delete k (S.insert k t) == t
prop_UnionInsert :: EL -> SET -> Bool
prop_UnionInsert x t
= S.union t (S.singleton x) == S.insert x t
prop_UnionComm :: SET -> SET -> Bool
prop_UnionComm t1 t2
= (S.union t1 t2 == S.union t2 t1)
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))
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_toAscList :: [EL] -> Bool
prop_toAscList xs
= (List.sort (List.nub xs) == S.toAscList (S.fromList xs))
-- the following is actually not specified. user cannot rely on it, but we check it anyway.
prop_toList :: [EL] -> Bool
prop_toList xs
= (List.sort (List.nub xs) == S.toList (S.fromList xs))
{-
Test instanciations.
: REFMODULE : TESTMODULE : K : A :
---------------------------------------
: Map : Data.Map : Int : Int :
-}
-- Module to test the interface of Map-like types.
-- These are all
-- black-box testing: we never check the internal data structures.
-- We are thus independant of the underlying representation.
import qualified REFMODULE as R
import qualified TESTMODULE as L
import LibTest
import Control.Monad
import Data.List as List
type REFCOLL = [(K,A)]
comparing f = \x y -> f x `compare` f y
testing f = \x y -> f x == f y
rIn :: REFCOLL -> REFCOLL
rIn = List.nubBy (testing fst)
lIn :: REFCOLL -> L.Map K A
lIn = L.fromList . rIn
rOut :: REFCOLL -> REFCOLL
rOut = List.sortBy (comparing fst)
lOut :: L.Map K A -> 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.)
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
a_b_maybe_a a b = if even a then Nothing else Just (a+b)
k_a_b_maybe_a k a b = if even a then Nothing else Just (a+b)
a_b_c = a_a_a
k_a_b = k_a_a
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_size :: REFCOLL -> Bool
prop_size refcol1
= (==) (L.size (lIn refcol1)) (R.size (rIn refcol1))
prop_member :: K -> REFCOLL -> Bool
prop_member k1 refcol2
= (==) (L.member k1 (lIn refcol2)) (R.member k1 (rIn refcol2))
prop_findWithDefault :: A -> K -> REFCOLL -> Bool
prop_findWithDefault a1 k2 refcol3