[Haskell-cafe] Creating QuickCheck properties

Joel Reymont joelr1 at gmail.com
Mon Apr 23 11:32:33 EDT 2007


Folks,

I have code like this that I want to test with QuickCheck but I'm  
having trouble imagining how I would wrap it up in a property.

Do I make sure that id, subs, back are always morphed properly or do  
I leave that to separate properties for their respective types?

Do I then ensure that array types are always unwrapped (see getType  
below), that a "series" variable is always declared, code added and a  
series reference returned?

Last but not least, is monadic testing part of Test.QuickCheck.*?

	Thanks, Joel

type Core a = State CoreUnit a

data CoreUnit
     = Core
       { coreSym :: Integer -- starting # for gensym
       , coreVars :: M.Map String VarDecl
       , coreCode :: M.Map Integer [Statement]
       }
     deriving (Show, Eq)

morphHistArrayAccess :: VarIdent -> Subscript -> BackRef -> C.Core  
C.Expr
morphHistArrayAccess id subs back = do
   id' <- morph id
   subs' <- morph subs
   back' <- morph back
   (C.TyArray ty) <- getType id'
   s <- genSym "series"
   addVar s (C.TySeries ty) [] Nothing
   addCodeFront 1 [ C.AddToSeries (C.VarIdent s) (C.Var id' subs') ]
   return $ C.Series (C.VarIdent s) back'


--
http://wagerlabs.com/







More information about the Haskell-Cafe mailing list