1{-# OPTIONS -fglasgow-exts #-} 2 3module GenUpTo (tests) where 4 5{- 6 7This example illustrate test-set generation, 8namely all terms of a given depth are generated. 9 10-} 11 12import Test.Tasty.HUnit 13 14import Data.Generics 15 16 17{- 18 19The following datatypes comprise the abstract syntax of a simple 20imperative language. Some provisions are such that the discussion 21of test-set generation is simplified. In particular, we do not 22consider anything but monomorphic *data*types --- no primitive 23types, no tuples, ... 24 25-} 26 27data Prog = Prog Dec Stat 28 deriving (Show, Eq, Typeable, Data) 29 30data Dec = Nodec 31 | Ondec Id Type 32 | Manydecs Dec Dec 33 deriving (Show, Eq, Typeable, Data) 34 35data Id = A | B 36 deriving (Show, Eq, Typeable, Data) 37 38data Type = Int | Bool 39 deriving (Show, Eq, Typeable, Data) 40 41data Stat = Noop 42 | Assign Id Exp 43 | Seq Stat Stat 44 deriving (Show, Eq, Typeable, Data) 45 46data Exp = Zero 47 | Succ Exp 48 deriving (Show, Eq, Typeable, Data) 49 50 51-- Generate all terms of a given depth 52genUpTo :: Data a => Int -> [a] 53genUpTo 0 = [] 54genUpTo d = result 55 where 56 -- Getting hold of the result (type) 57 result = concat (map recurse cons) 58 59 -- Retrieve constructors of the requested type 60 cons :: [Constr] 61 cons = dataTypeConstrs (dataTypeOf (head result)) 62 63 -- Find all terms headed by a specific Constr 64 recurse :: Data a => Constr -> [a] 65 recurse con = gmapM (\_ -> genUpTo (d-1)) 66 (fromConstr con) 67 68 -- We could also deal with primitive types easily. 69 -- Then we had to use cons' instead of cons. 70 -- 71 cons' :: [Constr] 72 cons' = case dataTypeRep ty of 73 AlgRep cons -> cons 74 IntRep -> [mkIntegralConstr ty 0] 75 FloatRep -> [mkIntegralConstr ty 0] 76 CharRep -> [mkCharConstr ty 'x'] 77 where 78 ty = dataTypeOf (head result) 79 80 81-- For silly tests 82data T0 = T0 T1 T2 T3 deriving (Show, Eq, Typeable, Data) 83data T1 = T1a | T1b deriving (Show, Eq, Typeable, Data) 84data T2 = T2a | T2b deriving (Show, Eq, Typeable, Data) 85data T3 = T3a | T3b deriving (Show, Eq, Typeable, Data) 86 87tests = ( genUpTo 0 :: [Id] 88 , ( genUpTo 1 :: [Id] 89 , ( genUpTo 2 :: [Id] 90 , ( genUpTo 2 :: [T0] 91 , ( genUpTo 3 :: [Prog] 92 ))))) @=? output 93 94output = ([],([A,B],([A,B],([T0 T1a T2a T3a,T0 T1a T2a T3b,T0 T1a T2b T3a,T0 T1a T2b T3b,T0 T1b T2a T3a,T0 T1b T2a T3b,T0 T1b T2b T3a,T0 T1b T2b T3b],[Prog Nodec Noop,Prog Nodec (Assign A Zero),Prog Nodec (Assign B Zero),Prog Nodec (Seq Noop Noop),Prog (Ondec A Int) Noop,Prog (Ondec A Int) (Assign A Zero),Prog (Ondec A Int) (Assign B Zero),Prog (Ondec A Int) (Seq Noop Noop),Prog (Ondec A Bool) Noop,Prog (Ondec A Bool) (Assign A Zero),Prog (Ondec A Bool) (Assign B Zero),Prog (Ondec A Bool) (Seq Noop Noop),Prog (Ondec B Int) Noop,Prog (Ondec B Int) (Assign A Zero),Prog (Ondec B Int) (Assign B Zero),Prog (Ondec B Int) (Seq Noop Noop),Prog (Ondec B Bool) Noop,Prog (Ondec B Bool) (Assign A Zero),Prog (Ondec B Bool) (Assign B Zero),Prog (Ondec B Bool) (Seq Noop Noop),Prog (Manydecs Nodec Nodec) Noop,Prog (Manydecs Nodec Nodec) (Assign A Zero),Prog (Manydecs Nodec Nodec) (Assign B Zero),Prog (Manydecs Nodec Nodec) (Seq Noop Noop)])))) 95