Skip to content

# publicleepike/SmartCheck

### Subversion checkout URL

You can clone with HTTPS or Subversion.

Fetching contributors…

Cannot retrieve contributors at this time

file 115 lines (91 sloc) 3.305 kb
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 `{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE DeriveGeneric #-}-- | Divide by 0 example in a simple arithmetic language.module Div0 whereimport Test.QuickCheckimport Test.SmartCheckimport Control.Monadimport GHC.Genericsimport Data.Typeable-----------------------------------------------------------------data Exp = C Int         | Add Exp Exp         | Div Exp Exp  deriving (Show, Typeable, Generic)instance SubTypes Expeval :: Exp -> Maybe Inteval (C i) = Just ieval (Add e0 e1) =  liftM2 (+) (eval e0) (eval e1)eval (Div e0 e1) =  let e = eval e1 in  if e == Just 0 then Nothing    else liftM2 div (eval e0) einstance Arbitrary Exp where  arbitrary = sized mkM    where    mkM 0 = liftM C arbitrary    mkM n = oneof [ liftM2 Add mkM' mkM'                  , liftM2 Div mkM' mkM' ]      where mkM' = mkM =<< choose (0,n-1)  -- shrink (C i) = map C (shrink i)  -- shrink (Add e0 e1) = [e0, e1]  -- shrink (Div e0 e1) = [e0, e1]-- property: so long as 0 isn't in the divisor, we won't try to divide by 0.-- It's false: something might evaluate to 0 still.prop_div :: Exp -> Propertyprop_div e = divSubTerms e ==> eval e /= Nothing-- prop_div e = property \$ case x of-- Nothing -> True-- Just True -> True-- _ -> False-- where x = fmap (< 1) (eval e)  -- precondition: no dividand in a subterm can be 0.divSubTerms :: Exp -> BooldivSubTerms (C _) = TruedivSubTerms (Div _ (C 0)) = FalsedivSubTerms (Add e0 e1) = divSubTerms e0 && divSubTerms e1divSubTerms (Div e0 e1) = divSubTerms e0 && divSubTerms e1-- div0 (A _ _) = property False-- div0 _ = property True-- prop_test m = case eval m of-- Nothing -> True-- Just i -> i < 5divTest :: IO ()divTest = smartCheck args prop_div  where  args = scStdArgs { qcArgs = stdArgs                                -- { maxSuccess = 1000                                -- , maxSize = 20 }                   , format = PrintString                   , runForall = True                   }-- Get the minimal offending sub-value.findVal :: Exp -> (Exp,Exp)findVal (Div e0 e1)  | eval e1 == Just 0 = (e0,e1)  | eval e1 == Nothing = findVal e1  | otherwise = findVal e0findVal a@(Add e0 e1)  | eval e0 == Nothing = findVal e0  | eval e1 == Nothing = findVal e1  | eval a == Just 0 = (a,a)findVal _ = error "not possible"divSubValue :: ExpdivSubValue =  Add (Div (C 5) (C (-12))) (Add (Add (C 2) (C 4)) (Add (C 7) (Div (C 3) (Add (C (-5)) (C 5)))))---------------------------------------------------------------------------------- data Foo = Foo Int Int-- | Bar Int Int-- deriving (Show, Typeable, Generic)-- instance SubTypes Foo-- instance Arbitrary Foo where-- arbitrary = do a <- arbitrary-- b <- arbitrary-- v <- arbitrary-- return \$ if v then Foo a b else Bar a b-- prop_foo :: Foo -> Int -> Int -> Bool-- prop_foo (Foo i j) k l = i /= k || j /= l || (k < 10 && l < 10)-- prop_foo (Bar i j) k l = i /= k || j /= l || (k < 10 && l < 10)-- runfoo :: IO ()-- runfoo = smartCheck scStdArgs prop_foo`
Something went wrong with that request. Please try again.