[add QuickCheck self-test mode enabled by --selftest
John Meacham <john@repetae.net>**20050914023620] addfile ./ArbitraryInstances.hs
hunk ./ArbitraryInstances.hs 1
+module ArbitraryInstances() where
+
+import Test.QuickCheck
+import Monad
+import Char(chr)
+
+instance Arbitrary a => Arbitrary (Maybe a) where
+    arbitrary = do
+        i <- choose ((0::Int),7)
+        if i == 0 then return Nothing else do
+            x <- arbitrary
+            return (Just x)
+    --coarbitrary Nothing = variant 0 . coarbitrary
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
+    arbitrary = do
+        i <- choose ((0::Int),1)
+        case i of
+            0 -> liftM Left arbitrary
+            1 -> liftM Right arbitrary
+
+instance Arbitrary Char where
+    arbitrary = g where
+        g = do
+            c <- choose (0x20, 0xFF)
+            if c > 0x7E && c < 0xA0 then g else return (chr c)
hunk ./Makefile 6
-PACKAGES= -package mtl  -package unix  #  -prof -auto-all
+PACKAGES= -package mtl  -package unix -package QuickCheck  #  -prof -auto-all
hunk ./Options.hs 15
+import SelfTest(selfTest)
hunk ./Options.hs 22
+    optSelfTest    :: !Bool,      -- ^ Perform self-test
hunk ./Options.hs 52
+    optSelfTest    = False,
hunk ./Options.hs 103
-    , Option []    ["ignore-ho"] (NoArg  (optIgnoreHo_s True)) "Ignore existing haskell object files"
+    , Option []    ["ignore-ho"]  (NoArg  (optIgnoreHo_s True)) "Ignore existing haskell object files"
hunk ./Options.hs 105
+    , Option []    ["selftest"]   (NoArg  (optSelfTest_s True)) "Perform internal integrity testing"
hunk ./Options.hs 141
+                        exitSuccess
+                    (Opt { optSelfTest = True},_) -> do
+                        putStrLn "Starting self testing..."
+                        SelfTest.selfTest ns
addfile ./SelfTest.hs
hunk ./SelfTest.hs 1
+module SelfTest(selfTest) where
+
+import Test.QuickCheck
+import Atom
+import Boolean.TestCases
+import ArbitraryInstances()
+import PackedString
+import HasSize
+
+
+
+selfTest :: [String] -> IO ()
+selfTest _ = do
+    putStrLn "Testing Boolean Library"
+    testBoolean
+    putStrLn "Testing Atom"
+    quickCheck prop_atomid
+    testPackedString
+    testHasSize
+
+prop_atomid xs = fromAtom (toAtom xs) == (xs::String)
+
+testPackedString = do
+    putStrLn "Testing PackedString"
+    let prop_psid xs = unpackPS (packString xs) == (xs::String)
+        prop_pslen xs = lengthPS (packString xs) == length (xs::String)
+        prop_psappend (xs,ys) = (packString xs `appendPS` packString ys) == packString ((xs::String) ++ ys)
+        prop_psappend' (xs,ys) = unpackPS (packString xs `appendPS` packString ys) == ((xs::String) ++ ys)
+    quickCheck prop_psid
+    quickCheck prop_pslen
+    quickCheck prop_psappend
+    quickCheck prop_psappend'
+
+testBoolean = do
+    quickCheck (\(x::Bool) -> prop_notnot x)
+    quickCheck (\(x::Int) -> prop_notnot x)
+    quickCheck (\(x::Int) -> prop_true x)
+    quickCheck (\(x::Int) -> prop_false x)
+    quickCheck (\(x::(Int,(Bool,Int))) -> prop_notnot x)
+    quickCheck (\(x::(Int,(Bool,Int))) -> prop_true x)
+    quickCheck (\(x::(Int,(Bool,Int))) -> prop_false x)
+    quickCheck (\(x::(Int,(Bool,Int))) -> prop_false' x)
+    quickCheck (\(x::[(Int,(Bool,Int))]) -> null x `trivial` prop_demorgan x)
+    quickCheck (\(x::[(Int,(Bool,Int))]) -> null x `trivial` prop_demorgan' x)
+    quickCheck $ prop_truefalse [3::Int] []
+    quickCheck $ prop_truefalse (Just True) Nothing
+    quickCheck $ prop_truefalse ((Right True),[3::Int]) (Left (), [])
+
+
+testHasSize = do
+    putStrLn "Testing HasSize"
+    let prop_gt (xs,n) = sizeGT n (xs::[Int]) == (length xs > n)
+        prop_gte (xs,n) = sizeGTE n (xs::[Int]) == (length xs >= n)
+        prop_lte (xs,n) = sizeLTE n (xs::[Int]) == (length xs <= n)
+    quickCheck prop_gt
+    quickCheck prop_gte
+    quickCheck prop_lte
+
+