lazysmallcheck 0.3 → 0.4
raw patch · 4 files changed
+9/−151 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- LICENSE +2/−2
- Test/LazySmallCheck.hs +5/−3
- Test/LazySmallCheck/Generic.hs +0/−143
- lazysmallcheck.cabal +2/−3
LICENSE view
@@ -1,4 +1,4 @@-Copyright Matthew Naylor 2006-2007.+Copyright Matthew Naylor 2006-2009. All rights reserved. Redistribution and use in source and binary forms, with or without@@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Neil Mitchell nor the names of other+ * Neither the name of Matthew Naylor nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
Test/LazySmallCheck.hs view
@@ -1,5 +1,7 @@--- Lazy SmallCheck (type-class variant, largely a SmallCheck subset)--- Lindblad, Naylor and Runciman+-- | For documentation, see the paper "SmallCheck and Lazy SmallCheck:+-- automatic exhaustive testing for small values" available at+-- <http://www.cs.york.ac.uk/fp/smallcheck/>. Several examples are+-- also included in the package. module Test.LazySmallCheck ( Serial(series) -- :: class@@ -238,7 +240,7 @@ neg :: Property -> Property neg p = Neg p -(*&*), (*|*), (*=>*) :: Property -> Property -> Property+(*&*), (*|*), (*=>*), (*=*) :: Property -> Property -> Property p *&* q = ParAnd p q p *|* q = neg (neg p *&* neg q) p *=>* q = neg (p *&* neg q)
− Test/LazySmallCheck/Generic.hs
@@ -1,143 +0,0 @@-{-# OPTIONS -fglasgow-exts #-} - -module Test.LazySmallCheck.Generic - ( depthCheck -- :: (Data a, Show a) => Int -> (a -> Bool) -> IO [a] - , (==>) -- :: Bool -> Bool -> Bool - ) where - -import Data.Maybe -import Data.Generics -import Control.Exception -import Control.Monad -import System.Exit - -uniquePrefix = "UP:" - -lenUniquePrefix = length uniquePrefix - -type Position = String - -initPData :: a -initPData = error uniquePrefix - -data HLP a = HLP Int (Either a [a]) - -refinePData :: Data a => String -> Int -> Position -> a -> [a] -refinePData s d = r - where - depleft = d - (length s - lenUniquePrefix) - r :: Data a => Position -> a -> [a] - r [] x = - let dt = dataTypeOf x - in case dataTypeRep dt of - AlgRep cons -> - let cons = dataTypeConstrs dt - z x = (0, x) - k (i, g) = (i + 1, g (error $ s ++ [toEnum i])) - xs' = map (gunfold k z) cons - in if depleft > 0 - then map snd xs' - else mapMaybe (\(ncon, x') -> - if ncon == 0 - then Just x' - else Nothing) xs' - IntRep -> mkPrim dt (mkIntConstr dt . toInteger) - [-depleft .. depleft] - StringRep -> mkPrim dt (mkStringConstr dt . (:[])) - (take (depleft+1) ['a' .. 'z']) - _ -> error $ "LazySmallCheck.Generic: Can't generate type " - ++ dataTypeName dt - r (c:ps) x = - let p = fromEnum c - z y = HLP 0 (Left y) - k (HLP i (Left xs)) y | i == p = HLP (i + 1) (Right $ map xs (r ps y)) - k (HLP i (Left xs)) y = HLP (i + 1) (Left $ xs y) - k (HLP i (Right xss)) y = HLP (i + 1) (Right $ map (\xs -> xs y) xss) - HLP _ (Right x') = gfoldl k z x - in x' - -mkPrim dt mk vs = map (\i -> fromJust $ gunfold undefined Just $ mk i) vs - --- - -mapVars :: Data a => (forall b . Data b => b -> IO b) -> a -> IO a -mapVars f = gmapM (\x -> Control.Exception.catch - (mapVars f x) - (\exc -> case exc of - ErrorCall s | take (length uniquePrefix) s == uniquePrefix -> - f x - _ -> throw exc - ) - ) - --- Taken from Ralf Laemmel, SYB website --- Generate all terms of a given depth -enumerate :: Data a => Int -> [a] -enumerate 0 = [] -enumerate d = result - where - -- Getting hold of the result (type) - result = concat (map recurse cons') - - -- Find all terms headed by a specific Constr - recurse :: Data a => Constr -> [a] - recurse con = gmapM (\_ -> enumerate (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 -> map (mkIntConstr ty . toInteger) [-d .. d] - StringRep -> map (mkStringConstr ty . (:[])) (take d ['a'..'z']) - --FloatRep -> - where - ty = dataTypeOf (head result) - -smallValue :: Data a => a -smallValue = f 1 - where - f d = case enumerate d of - [] -> f (d + 1) - (x:_) -> x - -smallInstance :: Data a => a -> IO a -smallInstance = mapVars (\_ -> return smallValue) - --- - -refute :: (Show a, Data a) => Int -> (a -> Bool) -> IO Int -refute d p = r initPData - where - r x = do res <- try (evaluate (p x)) - case res of - Right True -> return 1 - Right False -> stop x "Counter example found:" - Left (ErrorCall s) - | take (lenUniquePrefix) s == uniquePrefix -> - let pos = drop lenUniquePrefix s - in do ns <- mapM r (refinePData s d pos x) - return (1 + sum ns) - Left e -> stop x "Property crashed on input:" - - stop x s = do putStrLn s - x' <- smallInstance x - putStrLn (show x') - exitWith ExitSuccess - --- - -depthCheck :: (Show a, Data a) => Int -> (a -> Bool) -> IO () -depthCheck d f = do count <- refute d f - putStrLn $ "Completed " ++ show count - ++ " tests without finding a counter example." - --- - -infixr 0 ==> - -(==>) :: Bool -> Bool -> Bool -False ==> a = True -True ==> a = a
lazysmallcheck.cabal view
@@ -1,8 +1,8 @@ Name: lazysmallcheck-Version: 0.3+Version: 0.4 Maintainer: Matthew Naylor <mfn@cs.york.ac.uk> Homepage: http://www.cs.york.ac.uk/~mfn/lazysmallcheck/-Build-Depends: base, haskell98+Build-Depends: base < 5, haskell98 License: BSD3 License-File: LICENSE Author: Matthew Naylor and Fredrik Lindblad@@ -49,4 +49,3 @@ Exposed-modules: Test.LazySmallCheck- Test.LazySmallCheck.Generic