Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 70 lines (56 sloc) 1.774 kb
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
1 {-# LANGUAGE DeriveDataTypeable #-}
1269ec47 »
2012-05-09 Use GHC.Generics to implement the SubTypes class generically.
2 {-# LANGUAGE DeriveGeneric #-}
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
3
4 -- | Divide by 0 example in a simple arithmetic language.
5
6 module Div0 where
7
1d16a534 »
2012-05-02 Refactoring, modifying prettying-printing of extrapolated data.
8 import Test.QuickCheck
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
9 import Test.SmartCheck
10 import Control.Monad
11 import Data.Data
1269ec47 »
2012-05-09 Use GHC.Generics to implement the SubTypes class generically.
12
13 import GHC.Generics
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
14
15 data M = C Int
16 | A M M
17 | D M M
1269ec47 »
2012-05-09 Use GHC.Generics to implement the SubTypes class generically.
18 deriving (Read, Show, Data, Typeable, Eq, Generic)
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
19
1269ec47 »
2012-05-09 Use GHC.Generics to implement the SubTypes class generically.
20 instance SubTypes M
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
21
22 eval :: M -> Maybe Int
23 eval (C i) = Just i
24 eval (A a b) = do
25 i <- eval a
26 j <- eval b
27 return $ i + j
28 eval (D a b) =
29 if eval b == Just 0 then Nothing
30 else do i <- eval a
31 j <- eval b
32 return $ i `div` j
33
34 instance Arbitrary M where
35 arbitrary = sized mkM
36 where
37 mkM 0 = liftM C arbitrary
38 mkM n = oneof [ liftM2 A mkM' mkM'
39 , liftM2 D mkM' mkM' ]
40 where mkM' = mkM =<< choose (0,n-1)
41
1269ec47 »
2012-05-09 Use GHC.Generics to implement the SubTypes class generically.
42 -- shrink (C _) = []
43 -- shrink (A a b) = [a, b]
44 -- shrink (D a b) = [a, b]
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
45
f3c401fa »
2012-04-19 Remove unused stuff.
46 -- property: so long as 0 isn't in the divisor, we won't try to divide by 0.
47 -- It's false: something might evaluate to 0 still.
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
48 div1 :: M -> Property
f3c401fa »
2012-04-19 Remove unused stuff.
49 div1 m = divSubTerms m ==> eval m /= Nothing
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
50 where
384cba06 »
2012-04-18 Use Property rather than Bool.
51 -- precondition: no dividand in a subterm can be 0.
f3c401fa »
2012-04-19 Remove unused stuff.
52 divSubTerms (C _) = True
53 divSubTerms (D _ (C 0)) = False
54 divSubTerms (A m0 m1) = divSubTerms m0 && divSubTerms m1
55 divSubTerms (D m0 m1) = divSubTerms m0 && divSubTerms m1
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
56
3afbf3ee »
2012-04-20 Implemented recursive generalization. Isn't so effective, as QC keeps…
57 -- div0 (A _ _) = property False
58 -- div0 _ = property True
59
34aaaaa6 »
2012-05-02 Get the examples to compile.
60 divTest :: IO ()
61 divTest = smartCheck args div1
1d16a534 »
2012-05-02 Refactoring, modifying prettying-printing of extrapolated data.
62 where
63 args = scStdArgs { qcArgs = stdArgs
1269ec47 »
2012-05-09 Use GHC.Generics to implement the SubTypes class generically.
64 { maxSuccess = 1000
1d16a534 »
2012-05-02 Refactoring, modifying prettying-printing of extrapolated data.
65 , maxSize = 20 }
1269ec47 »
2012-05-09 Use GHC.Generics to implement the SubTypes class generically.
66 , treeShow = PrntString
1d16a534 »
2012-05-02 Refactoring, modifying prettying-printing of extrapolated data.
67 }
840f7674 »
2012-04-17 Trying to generalize from (a -> Bool) to QuickCheck.Property.
68
69 ---------------------------------------------------------------------------------
Something went wrong with that request. Please try again.