suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changed the unique identifiers in FlowGraphTest to be their own type, to reduce confusion

Browse Source
This commit is contained in:
Neil Brown 2007-11-09 20:05:06 +00:00
parent 83ab0c16f5
commit d60d70cf82
1 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
common/FlowGraphTest.hs
View File

@ -243,8 +243,16 @@ testIf = TestList
-- which means we'd want Gen [([Meta],a)]
-- However, in order to ensure we make unique meta tags, we have to add the StateT Int wrapper:
newtype Id = Id Int
fromId :: Id -> Int
fromId (Id n) = n
makeMeta' :: Id -> Meta
makeMeta' = makeMeta . fromId
type GenL a = StateT Int Gen [([Meta], a)]
type GenL a = StateT Id Gen [([Meta], a)]
replaceMeta :: Meta -> Meta
replaceMeta m = sub m 8
@ -288,20 +296,25 @@ comb3 func list0 list1 list2 = (liftM3 (,,)) list0 list1 list2 >>* product3 >>*
-- | Wrapper for Quickcheck.
-- In order to stop conflict with Quickcheck's in-built rules for things such as pairs
-- (which do not allow overlapping instances), we have to wrap such types ourself.
data QC a = QC a deriving (Eq, Show)
newtype QC a = QC a deriving (Eq, Show)
instance Arbitrary (QC (A.Structured, Map.Map [Meta] A.Structured)) where
arbitrary = evalStateT genStructured 0 >>* findEmpty >>* QC
arbitrary = evalStateT genStructured (Id 0) >>* findEmpty >>* QC
where
-- Copies the value for the empty-list key into the first element of the tuple:
findEmpty :: [([Meta], a)] -> (a, Map.Map [Meta] a)
findEmpty xs = (fromJust $ Map.lookup [] m, m)
where m = Map.fromList xs
-- TODO define a method for coarbitrary?
-- coarbitrary is for defined "twiddle" functions over data generated by arbitrary.
-- For example, we could have the twiddle functions changing an expression
-- in the tree. I don't think this would be of use right now, given what we're testing
nextIdT :: Monad m => StateT Int m Int
nextIdT = modify' ((+) 1)
nextIdT :: Monad m => StateT Id m Id
nextIdT = modify' incId
where
incId :: Id -> Id
incId (Id n) = (Id $ n+1)
oneofL :: [GenL a] -> GenL a
oneofL gs = do i <- lift $ choose (0,length gs-1)
@ -313,7 +326,7 @@ replaceM find replace x | find == x = return replace
genStructured :: GenL A.Structured
genStructured = nextIdT >>* makeMeta >>= \m -> oneofL
genStructured = nextIdT >>* makeMeta' >>= \m -> oneofL
[
genElem2 A.OnlyP m genProcess
-- TODO A.Several m []
@ -321,7 +334,7 @@ genStructured = nextIdT >>* makeMeta >>= \m -> oneofL
genProcess :: GenL A.Process
genProcess = nextIdT >>* makeMeta >>= \m -> oneofL
genProcess = nextIdT >>* makeMeta' >>= \m -> oneofL
[
genElem1 A.Skip m
,genElem1 A.Stop m