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

@ -244,7 +244,15 @@ testIf = TestList
-- However, in order to ensure we make unique meta tags, we have to add the StateT Int wrapper: -- However, in order to ensure we make unique meta tags, we have to add the StateT Int wrapper:
type GenL a = StateT Int Gen [([Meta], a)] newtype Id = Id Int
fromId :: Id -> Int
fromId (Id n) = n
makeMeta' :: Id -> Meta
makeMeta' = makeMeta . fromId
type GenL a = StateT Id Gen [([Meta], a)]
replaceMeta :: Meta -> Meta replaceMeta :: Meta -> Meta
replaceMeta m = sub m 8 replaceMeta m = sub m 8
@ -288,20 +296,25 @@ comb3 func list0 list1 list2 = (liftM3 (,,)) list0 list1 list2 >>* product3 >>*
-- | Wrapper for Quickcheck. -- | Wrapper for Quickcheck.
-- In order to stop conflict with Quickcheck's in-built rules for things such as pairs -- 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. -- (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 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 where
-- Copies the value for the empty-list key into the first element of the tuple: -- Copies the value for the empty-list key into the first element of the tuple:
findEmpty :: [([Meta], a)] -> (a, Map.Map [Meta] a) findEmpty :: [([Meta], a)] -> (a, Map.Map [Meta] a)
findEmpty xs = (fromJust $ Map.lookup [] m, m) findEmpty xs = (fromJust $ Map.lookup [] m, m)
where m = Map.fromList xs 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 :: Monad m => StateT Id m Id
nextIdT = modify' ((+) 1) nextIdT = modify' incId
where
incId :: Id -> Id
incId (Id n) = (Id $ n+1)
oneofL :: [GenL a] -> GenL a oneofL :: [GenL a] -> GenL a
oneofL gs = do i <- lift $ choose (0,length gs-1) 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 :: GenL A.Structured
genStructured = nextIdT >>* makeMeta >>= \m -> oneofL genStructured = nextIdT >>* makeMeta' >>= \m -> oneofL
[ [
genElem2 A.OnlyP m genProcess genElem2 A.OnlyP m genProcess
-- TODO A.Several m [] -- TODO A.Several m []
@ -321,7 +334,7 @@ genStructured = nextIdT >>* makeMeta >>= \m -> oneofL
genProcess :: GenL A.Process genProcess :: GenL A.Process
genProcess = nextIdT >>* makeMeta >>= \m -> oneofL genProcess = nextIdT >>* makeMeta' >>= \m -> oneofL
[ [
genElem1 A.Skip m genElem1 A.Skip m
,genElem1 A.Stop m ,genElem1 A.Stop m