a43ceed7e0d6de6215b4ce3a5985219e147ffbc3
[packages/binary.git] / tests / QC.hs
1 {-# OPTIONS_GHC -fglasgow-exts #-}
2 module Main where
3
4 import Data.Binary
5 import Data.Binary.Put
6 import Data.Binary.Get
7
8 import qualified Data.ByteString as B
9 import qualified Data.ByteString.Base as B
10 import qualified Data.ByteString.Lazy as L
11 import qualified Data.Map as Map
12 import qualified Data.Set as Set
13 import qualified Data.IntMap as IntMap
14 import qualified Data.IntSet as IntSet
15 import qualified Data.Sequence as Seq
16
17 import Data.Array (Array)
18 import Data.Array.IArray
19 import Data.Array.Unboxed (UArray)
20
21 import Control.Monad
22 import Foreign
23 import System.Environment
24 import System.IO
25
26 import Test.QuickCheck
27 import QuickCheckUtils
28 import Text.Printf
29
30 roundTrip :: (Eq a, Binary a) => a -> Bool
31 roundTrip a = a == decode (encode a)
32
33 roundTripWith put get x = x == runGet get (runPut (put x))
34
35 instance Arbitrary Word8 where
36 arbitrary = liftM fromIntegral (choose (0, 2^8-1))
37 coarbitrary w = variant 0
38
39 instance Arbitrary Word16 where
40 arbitrary = liftM fromIntegral (choose (0, 2^16-1))
41 coarbitrary = undefined
42
43 instance Arbitrary Word32 where
44 arbitrary = liftM fromIntegral (choose (0, 2^32-1))
45 coarbitrary = undefined
46
47 instance Arbitrary Word64 where
48 arbitrary = liftM fromIntegral (choose (0, 2^64-1))
49 coarbitrary = undefined
50
51 instance Arbitrary Int8 where
52 arbitrary = liftM fromIntegral (choose (0, 2^8-1))
53 coarbitrary w = variant 0
54
55 instance Arbitrary Int16 where
56 arbitrary = liftM fromIntegral (choose (0, 2^16-1))
57 coarbitrary = undefined
58
59 instance Arbitrary Int32 where
60 arbitrary = liftM fromIntegral (choose (0, 2^32-1))
61 coarbitrary = undefined
62
63 instance Arbitrary Int64 where
64 arbitrary = liftM fromIntegral (choose (0, 2^64-1))
65 coarbitrary = undefined
66
67 instance Arbitrary Char where
68 arbitrary = choose (maxBound, minBound)
69 coarbitrary = undefined
70
71 instance Arbitrary a => Arbitrary (Maybe a) where
72 arbitrary = oneof [ return Nothing, liftM Just arbitrary]
73 coarbitrary = undefined
74
75 instance (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
76 arbitrary = oneof [ liftM Left arbitrary, liftM Right arbitrary]
77 coarbitrary = undefined
78
79 instance Arbitrary IntSet.IntSet where
80 arbitrary = fmap IntSet.fromList arbitrary
81 coarbitrary = undefined
82
83 instance (Arbitrary e) => Arbitrary (IntMap.IntMap e) where
84 arbitrary = fmap IntMap.fromList arbitrary
85 coarbitrary = undefined
86
87 instance (Arbitrary a, Ord a) => Arbitrary (Set.Set a) where
88 arbitrary = fmap Set.fromList arbitrary
89 coarbitrary = undefined
90
91 instance (Arbitrary a, Ord a, Arbitrary b) => Arbitrary (Map.Map a b) where
92 arbitrary = fmap Map.fromList arbitrary
93 coarbitrary = undefined
94
95 instance (Arbitrary a) => Arbitrary (Seq.Seq a) where
96 arbitrary = fmap Seq.fromList arbitrary
97 coarbitrary = undefined
98
99 instance Arbitrary L.ByteString where
100 arbitrary = arbitrary >>= return . B.LPS . filter (not. B.null) -- maintain the invariant.
101 coarbitrary s = coarbitrary (L.unpack s)
102
103 instance Arbitrary B.ByteString where
104 arbitrary = B.pack `fmap` arbitrary
105 coarbitrary s = coarbitrary (B.unpack s)
106
107 -- low level ones:
108
109 prop_Word16be = roundTripWith putWord16be getWord16be
110 prop_Word16le = roundTripWith putWord16le getWord16le
111
112 prop_Word32be = roundTripWith putWord32be getWord32be
113 prop_Word32le = roundTripWith putWord32le getWord32le
114
115 prop_Word64be = roundTripWith putWord64be getWord64be
116 prop_Word64le = roundTripWith putWord64le getWord64le
117
118 main :: IO ()
119 main = do
120 hSetBuffering stdout NoBuffering
121 run tests
122
123 run :: [(String, Int -> IO ())] -> IO ()
124 run tests = do
125 x <- getArgs
126 let n = if null x then 100 else read . head $ x
127 mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
128
129 tests =
130 [ ("Word16be", mytest prop_Word16be)
131 , ("Word16le", mytest prop_Word16le)
132 , ("Word32be", mytest prop_Word32be)
133 , ("Word32le", mytest prop_Word32le)
134 , ("Word64be", mytest prop_Word64be)
135 , ("Word64le", mytest prop_Word64le)
136 -- higher level ones using the Binary class
137 ,("()", mytest (roundTrip :: () -> Bool))
138 ,("Bool", mytest (roundTrip :: Bool -> Bool))
139 ,("Char", mytest (roundTrip :: Char -> Bool))
140 ,("Int", mytest (roundTrip :: Int -> Bool))
141 ,("Word8", mytest (roundTrip :: Word8 -> Bool))
142 ,("Word16", mytest (roundTrip :: Word16 -> Bool))
143 ,("Word32", mytest (roundTrip :: Word32 -> Bool))
144 ,("Word64", mytest (roundTrip :: Word64 -> Bool))
145 ,("Int8", mytest (roundTrip :: Int8 -> Bool))
146 ,("Int16", mytest (roundTrip :: Int16 -> Bool))
147 ,("Int32", mytest (roundTrip :: Int32 -> Bool))
148 ,("Int64", mytest (roundTrip :: Int64 -> Bool))
149 ,("[Word8]", mytest (roundTrip :: [Word8] -> Bool))
150 ,("String", mytest (roundTrip :: String -> Bool))
151 ,("Maybe Int8", mytest (roundTrip :: Maybe Int8 -> Bool))
152 ,("Either Int8 Int16", mytest (roundTrip :: Either Int8 Int16 -> Bool))
153 ,("(Int32, [Int])", mytest (roundTrip :: (Int32, [Int]) -> Bool))
154 ,("(Maybe Int64, Bool, [Int])", mytest (roundTrip :: (Maybe Int64, Bool, [Int]) -> Bool))
155 ,("(Maybe Word8, Bool, [Int], Either Bool Word8)", mytest (roundTrip :: (Maybe Word8, Bool, [Int], Either Bool Word8) -> Bool))
156 {- ,("(Maybe Word16, Bool, [Int], Either Bool Word16, Int)", mytest (roundTrip :: (Maybe Word16, Bool, [Int], Either Bool Word16, Int) -> Bool))
157 ,("(Maybe Word32, Bool, [Int], Either Bool Word32, Int, Int)", mytest (roundTrip :: (Maybe Word32, Bool, [Int], Either Bool Word32, Int, Int) -> Bool))
158 ,("(Maybe Word64, Bool, [Int], Either Bool Word64, Int, Int, Int)", mytest (roundTrip :: (Maybe Word64, Bool, [Int], Either Bool Word64, Int, Int, Int) -> Bool))-}
159 ,("B.ByteString", mytest (roundTrip :: B.ByteString -> Bool))
160 ,("L.ByteString", mytest (roundTrip :: L.ByteString -> Bool))
161 ,("IntSet", mytest (roundTrip :: IntSet.IntSet -> Bool))
162 ,("IntMap String", mytest (roundTrip :: IntMap.IntMap String -> Bool))
163 ,("Set Word32", mytest (roundTrip :: Set.Set Word32 -> Bool))
164 ,("Map Word16 Int", mytest (roundTrip :: Map.Map Word16 Int -> Bool))
165 ,("Sequence", mytest (roundTrip :: Seq.Seq Int64 -> Bool))
166 ]