syb-0.3.6: tests/GenUpTo.hs

{-# OPTIONS -fglasgow-exts #-}

module GenUpTo (tests) where

{-

This example illustrate test-set generation,
namely all terms of a given depth are generated.

-}

import Test.HUnit

import Data.Generics


{-

The following datatypes comprise the abstract syntax of a simple
imperative language. Some provisions are such that the discussion
of test-set generation is simplified. In particular, we do not 
consider anything but monomorphic *data*types --- no primitive
types, no tuples, ...

-}
 
data Prog = Prog Dec Stat 
            deriving (Show, Eq, Typeable, Data)

data Dec  = Nodec
          | Ondec Id Type 
          | Manydecs Dec Dec
            deriving (Show, Eq, Typeable, Data)

data Id = A | B
          deriving (Show, Eq, Typeable, Data)

data Type = Int | Bool
            deriving (Show, Eq, Typeable, Data)

data Stat = Noop
          | Assign Id Exp
          | Seq Stat Stat
            deriving (Show, Eq, Typeable, Data)

data Exp = Zero 
         | Succ Exp
           deriving (Show, Eq, Typeable, Data)


-- Generate all terms of a given depth
genUpTo :: Data a => Int -> [a]
genUpTo 0 = []
genUpTo d = result
   where
     -- Getting hold of the result (type)
     result = concat (map recurse cons)

     -- Retrieve constructors of the requested type
     cons :: [Constr]
     cons = dataTypeConstrs (dataTypeOf (head result))

     -- Find all terms headed by a specific Constr
     recurse :: Data a => Constr -> [a]
     recurse con = gmapM (\_ -> genUpTo (d-1)) 
                         (fromConstr con)

     -- We could also deal with primitive types easily.
     -- Then we had to use cons' instead of cons.
     --
     cons' :: [Constr]
     cons' = case dataTypeRep ty of
              AlgRep cons -> cons
              IntRep      -> [mkIntegralConstr ty 0]
              FloatRep    -> [mkIntegralConstr ty 0]
              CharRep     -> [mkCharConstr ty 'x']
      where
        ty = dataTypeOf (head result)     


-- For silly tests
data T0 = T0 T1 T2 T3 deriving (Show, Eq, Typeable, Data)
data T1 = T1a | T1b   deriving (Show, Eq, Typeable, Data)
data T2 = T2a | T2b   deriving (Show, Eq, Typeable, Data)
data T3 = T3a | T3b   deriving (Show, Eq, Typeable, Data)

tests = (   genUpTo 0 :: [Id]
        , ( genUpTo 1 :: [Id]
        , ( genUpTo 2 :: [Id]
        , ( genUpTo 2 :: [T0]
        , ( genUpTo 3 :: [Prog]
        ))))) ~=? output

output = ([],([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)]))))