1{-# LANGUAGE CPP, ScopedTypeVariables, DataKinds, TypeSynonymInstances #-} 2module Main ( main ) where 3 4#if MIN_VERSION_base(4,8,0) 5#define HAS_NATURAL 6#endif 7 8#if MIN_VERSION_base(4,7,0) 9#define HAS_FIXED_CONSTRUCTOR 10#endif 11 12import Control.Applicative 13import Control.Exception as C (SomeException, 14 catch, evaluate) 15import Control.Monad (unless, liftM2) 16import qualified Data.ByteString as B 17import qualified Data.ByteString.Lazy as L 18import qualified Data.ByteString.Lazy.Internal as L 19#if MIN_VERSION_bytestring(0,10,4) 20import Data.ByteString.Short (ShortByteString) 21#endif 22import Data.Int 23import Data.Ratio 24import Data.Typeable 25import System.IO.Unsafe 26 27import Data.Orphans () 28 29#ifdef HAS_NATURAL 30import Numeric.Natural 31#endif 32 33import GHC.Fingerprint 34 35import qualified Data.Fixed as Fixed 36 37import Test.Framework 38import Test.Framework.Providers.QuickCheck2 39import Test.QuickCheck hiding (total) 40 41import qualified Action (tests) 42import Arbitrary () 43import Data.Binary 44import Data.Binary.Get 45import Data.Binary.Put 46 47 48------------------------------------------------------------------------ 49 50roundTrip :: (Eq a, Binary a) => a -> (L.ByteString -> L.ByteString) -> Bool 51roundTrip a f = a == 52 {-# SCC "decode.refragment.encode" #-} decode (f (encode a)) 53 54roundTripWith :: Eq a => (a -> Put) -> Get a -> a -> Property 55roundTripWith putter getter x = 56 forAll positiveList $ \xs -> 57 x == runGet getter (refragment xs (runPut (putter x))) 58 59-- make sure that a test fails 60mustThrowError :: B a 61mustThrowError a = unsafePerformIO $ 62 C.catch (do _ <- C.evaluate a 63 return False) 64 (\(_e :: SomeException) -> return True) 65 66-- low level ones: 67-- 68-- Words 69 70prop_Word8 :: Word8 -> Property 71prop_Word8 = roundTripWith putWord8 getWord8 72 73prop_Word16be :: Word16 -> Property 74prop_Word16be = roundTripWith putWord16be getWord16be 75 76prop_Word16le :: Word16 -> Property 77prop_Word16le = roundTripWith putWord16le getWord16le 78 79prop_Word16host :: Word16 -> Property 80prop_Word16host = roundTripWith putWord16host getWord16host 81 82prop_Word32be :: Word32 -> Property 83prop_Word32be = roundTripWith putWord32be getWord32be 84 85prop_Word32le :: Word32 -> Property 86prop_Word32le = roundTripWith putWord32le getWord32le 87 88prop_Word32host :: Word32 -> Property 89prop_Word32host = roundTripWith putWord32host getWord32host 90 91prop_Word64be :: Word64 -> Property 92prop_Word64be = roundTripWith putWord64be getWord64be 93 94prop_Word64le :: Word64 -> Property 95prop_Word64le = roundTripWith putWord64le getWord64le 96 97prop_Word64host :: Word64 -> Property 98prop_Word64host = roundTripWith putWord64host getWord64host 99 100prop_Wordhost :: Word -> Property 101prop_Wordhost = roundTripWith putWordhost getWordhost 102 103-- Ints 104 105prop_Int8 :: Int8 -> Property 106prop_Int8 = roundTripWith putInt8 getInt8 107 108prop_Int16be :: Int16 -> Property 109prop_Int16be = roundTripWith putInt16be getInt16be 110 111prop_Int16le :: Int16 -> Property 112prop_Int16le = roundTripWith putInt16le getInt16le 113 114prop_Int16host :: Int16 -> Property 115prop_Int16host = roundTripWith putInt16host getInt16host 116 117prop_Int32be :: Int32 -> Property 118prop_Int32be = roundTripWith putInt32be getInt32be 119 120prop_Int32le :: Int32 -> Property 121prop_Int32le = roundTripWith putInt32le getInt32le 122 123prop_Int32host :: Int32 -> Property 124prop_Int32host = roundTripWith putInt32host getInt32host 125 126prop_Int64be :: Int64 -> Property 127prop_Int64be = roundTripWith putInt64be getInt64be 128 129prop_Int64le :: Int64 -> Property 130prop_Int64le = roundTripWith putInt64le getInt64le 131 132prop_Int64host :: Int64 -> Property 133prop_Int64host = roundTripWith putInt64host getInt64host 134 135prop_Inthost :: Int -> Property 136prop_Inthost = roundTripWith putInthost getInthost 137 138-- Floats and Doubles 139 140prop_Floatbe :: Float -> Property 141prop_Floatbe = roundTripWith putFloatbe getFloatbe 142 143prop_Floatle :: Float -> Property 144prop_Floatle = roundTripWith putFloatle getFloatle 145 146prop_Floathost :: Float -> Property 147prop_Floathost = roundTripWith putFloathost getFloathost 148 149prop_Doublebe :: Double -> Property 150prop_Doublebe = roundTripWith putDoublebe getDoublebe 151 152prop_Doublele :: Double -> Property 153prop_Doublele = roundTripWith putDoublele getDoublele 154 155prop_Doublehost :: Double -> Property 156prop_Doublehost = roundTripWith putDoublehost getDoublehost 157 158#if MIN_VERSION_base(4,10,0) 159testTypeable :: Test 160testTypeable = testProperty "TypeRep" prop_TypeRep 161 162prop_TypeRep :: TypeRep -> Property 163prop_TypeRep = roundTripWith put get 164 165atomicTypeReps :: [TypeRep] 166atomicTypeReps = 167 [ typeRep (Proxy :: Proxy ()) 168 , typeRep (Proxy :: Proxy String) 169 , typeRep (Proxy :: Proxy Int) 170 , typeRep (Proxy :: Proxy (,)) 171 , typeRep (Proxy :: Proxy ((,) (Maybe Int))) 172 , typeRep (Proxy :: Proxy Maybe) 173 , typeRep (Proxy :: Proxy 'Nothing) 174 , typeRep (Proxy :: Proxy 'Left) 175 , typeRep (Proxy :: Proxy "Hello") 176 , typeRep (Proxy :: Proxy 42) 177 , typeRep (Proxy :: Proxy '[1,2,3,4]) 178 , typeRep (Proxy :: Proxy ('Left Int)) 179 , typeRep (Proxy :: Proxy (Either Int String)) 180 , typeRep (Proxy :: Proxy (() -> ())) 181 ] 182 183instance Arbitrary TypeRep where 184 arbitrary = oneof (map pure atomicTypeReps) 185#else 186testTypeable :: Test 187testTypeable = testGroup "Skipping Typeable tests" [] 188#endif 189 190-- done, partial and fail 191 192-- | Test partial results. 193-- May or may not use the whole input, check conditions for the different 194-- outcomes. 195prop_partial :: L.ByteString -> Property 196prop_partial lbs = forAll (choose (0, L.length lbs * 2)) $ \skipN -> 197 let result = pushChunks (runGetIncremental decoder) lbs 198 decoder = do 199 s <- getByteString (fromIntegral skipN) 200 return (L.fromChunks [s]) 201 in case result of 202 Partial _ -> L.length lbs < skipN 203 Done unused _pos value -> 204 and [ L.length value == skipN 205 , L.append value (L.fromChunks [unused]) == lbs 206 ] 207 Fail _ _ _ -> False 208 209-- | Fail a decoder and make sure the result is sane. 210prop_fail :: L.ByteString -> String -> Property 211prop_fail lbs msg = forAll (choose (0, L.length lbs)) $ \pos -> 212 let result = pushChunks (runGetIncremental decoder) lbs 213 decoder = do 214 -- use part of the input... 215 _ <- getByteString (fromIntegral pos) 216 -- ... then fail 217 fail msg 218 in case result of 219 Fail unused pos' msg' -> 220 and [ pos == pos' 221 , msg == msg' 222 , L.length lbs - pos == fromIntegral (B.length unused) 223 , L.fromChunks [unused] `L.isSuffixOf` lbs 224 ] 225 _ -> False -- wuut? 226 227-- read negative length 228prop_getByteString_negative :: Int -> Property 229prop_getByteString_negative n = 230 n < 1 ==> 231 runGet (getByteString n) L.empty == B.empty 232 233 234prop_bytesRead :: L.ByteString -> Property 235prop_bytesRead lbs = 236 forAll (makeChunks 0 totalLength) $ \chunkSizes -> 237 let result = pushChunks (runGetIncremental decoder) lbs 238 decoder = do 239 -- Read some data and invoke bytesRead several times. 240 -- Each time, check that the values are what we expect. 241 flip mapM_ chunkSizes $ \(total, step) -> do 242 _ <- getByteString (fromIntegral step) 243 n <- bytesRead 244 unless (n == total) $ fail "unexpected position" 245 bytesRead 246 in case result of 247 Done unused pos value -> 248 and [ value == totalLength 249 , pos == value 250 , B.null unused 251 ] 252 Partial _ -> False 253 Fail _ _ _ -> False 254 where 255 totalLength = L.length lbs 256 makeChunks total i 257 | i == 0 = return [] 258 | otherwise = do 259 n <- choose (0,i) 260 let total' = total + n 261 rest <- makeChunks total' (i - n) 262 return ((total',n):rest) 263 264 265-- | We're trying to guarantee that the Decoder will not ask for more input 266-- with Partial if it has been given Nothing once. 267-- In this test we're making the decoder return 'Partial' to get more 268-- input, and to get knownledge of the current position using 'BytesRead'. 269-- Both of these operations, when used with the <|> operator, result internally 270-- in that the decoder return with Partial and BytesRead multiple times, 271-- in which case we need to keep track of if the user has passed Nothing to a 272-- Partial in the past. 273prop_partialOnlyOnce :: Property 274prop_partialOnlyOnce = property $ 275 let result = runGetIncremental (decoder <|> decoder) 276 decoder = do 277 0 <- bytesRead 278 _ <- getWord8 -- this will make the decoder return with Partial 279 return "shouldn't get here" 280 in case result of 281 -- we expect Partial followed by Fail 282 Partial k -> case k Nothing of -- push down a Nothing 283 Fail _ _ _ -> True 284 Partial _ -> error $ "partial twice! oh noes!" 285 Done _ _ _ -> error $ "we're not supposed to be done." 286 _ -> error $ "not partial, error!" 287 288-- read too much 289prop_readTooMuch :: (Eq a, Binary a) => a -> Bool 290prop_readTooMuch x = mustThrowError $ x == a && x /= b 291 where 292 -- encode 'a', but try to read 'b' too 293 (a,b) = decode (encode x) 294 _types = [a,b] 295 296-- In binary-0.5 the Get monad looked like 297-- 298-- > data S = S {-# UNPACK #-} !B.ByteString 299-- > L.ByteString 300-- > {-# UNPACK #-} !Int64 301-- > 302-- > newtype Get a = Get { unGet :: S -> (# a, S #) } 303-- 304-- with a helper function 305-- 306-- > mkState :: L.ByteString -> Int64 -> S 307-- > mkState l = case l of 308-- > L.Empty -> S B.empty L.empty 309-- > L.Chunk x xs -> S x xs 310-- 311-- Note that mkState is strict in its first argument. This goes wrong in this 312-- function: 313-- 314-- > getBytes :: Int -> Get B.ByteString 315-- > getBytes n = do 316-- > S s ss bytes <- traceNumBytes n $ get 317-- > if n <= B.length s 318-- > then do let (consume,rest) = B.splitAt n s 319-- > put $! S rest ss (bytes + fromIntegral n) 320-- > return $! consume 321-- > else 322-- > case L.splitAt (fromIntegral n) (s `join` ss) of 323-- > (consuming, rest) -> 324-- > do let now = B.concat . L.toChunks $ consuming 325-- > put $ mkState rest (bytes + fromIntegral n) 326-- > -- forces the next chunk before this one is returned 327-- > if (B.length now < n) 328-- > then 329-- > fail "too few bytes" 330-- > else 331-- > return now 332-- 333-- Consider the else-branch of this function; suppose we ask for n bytes; 334-- the call to L.splitAt gives us a lazy bytestring 'consuming' of precisely @n@ 335-- bytes (unless we don't have enough data, in which case we fail); but then 336-- the strict evaluation of mkState on 'rest' means we look ahead too far. 337-- 338-- Although this is all done completely differently in binary-0.7 it is 339-- important that the same bug does not get introduced in some other way. The 340-- test is basically the same test that already exists in this test suite, 341-- verifying that 342-- 343-- > decode . refragment . encode == id 344-- 345-- However, we use a different 'refragment', one that introduces an exception 346-- as the tail of the bytestring after rechunking. If we don't look ahead too 347-- far then this should make no difference, but if we do then this will throw 348-- an exception (for instance, in binary-0.5, this will throw an exception for 349-- certain rechunkings, but not for others). 350-- 351-- To make sure that the property holds no matter what refragmentation we use, 352-- we test exhaustively for a single chunk, and all ways to break the string 353-- into 2, 3 and 4 chunks. 354prop_lookAheadIndepOfChunking :: (Eq a, Binary a) => a -> Property 355prop_lookAheadIndepOfChunking testInput = 356 forAll (testCuts (L.length (encode testInput))) $ 357 roundTrip testInput . rechunk 358 where 359 testCuts :: forall a. (Num a, Enum a) => a -> Gen [a] 360 testCuts len = elements $ [ [] ] 361 ++ [ [i] 362 | i <- [0 .. len] ] 363 ++ [ [i, j] 364 | i <- [0 .. len] 365 , j <- [0 .. len - i] ] 366 ++ [ [i, j, k] 367 | i <- [0 .. len] 368 , j <- [0 .. len - i] 369 , k <- [0 .. len - i - j] ] 370 371 -- Rechunk a bytestring, leaving the tail as an exception rather than Empty 372 rechunk :: forall a. Integral a => [a] -> L.ByteString -> L.ByteString 373 rechunk cuts = fromChunks . cut cuts . B.concat . L.toChunks 374 where 375 cut :: [a] -> B.ByteString -> [B.ByteString] 376 cut [] bs = [bs] 377 cut (i:is) bs = let (bs0, bs1) = B.splitAt (fromIntegral i) bs 378 in bs0 : cut is bs1 379 380 fromChunks :: [B.ByteString] -> L.ByteString 381 fromChunks [] = error "Binary should not have to ask for this chunk!" 382 fromChunks (bs:bss) = L.Chunk bs (fromChunks bss) 383 384-- String utilities 385 386prop_getLazyByteString :: L.ByteString -> Property 387prop_getLazyByteString lbs = forAll (choose (0, 2 * L.length lbs)) $ \len -> 388 let result = pushChunks (runGetIncremental decoder) lbs 389 decoder = getLazyByteString len 390 in case result of 391 Done unused _pos value -> 392 and [ value == L.take len lbs 393 , L.fromChunks [unused] == L.drop len lbs 394 ] 395 Partial _ -> len > L.length lbs 396 _ -> False 397 398prop_getLazyByteStringNul :: Word16 -> [Int] -> Property 399prop_getLazyByteStringNul count0 fragments = count >= 0 ==> 400 forAll (choose (0, count)) $ \pos -> 401 let lbs = case L.splitAt pos (L.replicate count 65) of 402 (start,end) -> refragment fragments $ L.concat [start, L.singleton 0, end] 403 result = pushEndOfInput $ pushChunks (runGetIncremental getLazyByteStringNul) lbs 404 in case result of 405 Done unused pos' value -> 406 and [ value == L.take pos lbs 407 , pos + 1 == pos' -- 1 for the NUL 408 , L.fromChunks [unused] == L.drop (pos + 1) lbs 409 ] 410 _ -> False 411 where 412 count = fromIntegral count0 -- to make the generated numbers a bit smaller 413 414-- | Same as prop_getLazyByteStringNul, but without any NULL in the string. 415prop_getLazyByteStringNul_noNul :: Word16 -> [Int] -> Property 416prop_getLazyByteStringNul_noNul count0 fragments = count >= 0 ==> 417 let lbs = refragment fragments $ L.replicate count 65 418 result = pushEndOfInput $ pushChunks (runGetIncremental getLazyByteStringNul) lbs 419 in case result of 420 Fail _ _ _ -> True 421 _ -> False 422 where 423 count = fromIntegral count0 -- to make the generated numbers a bit smaller 424 425prop_getRemainingLazyByteString :: L.ByteString -> Property 426prop_getRemainingLazyByteString lbs = property $ 427 let result = pushEndOfInput $ pushChunks (runGetIncremental getRemainingLazyByteString) lbs 428 in case result of 429 Done unused pos value -> 430 and [ value == lbs 431 , B.null unused 432 , fromIntegral pos == L.length lbs 433 ] 434 _ -> False 435 436-- sanity: 437 438invariant_lbs :: L.ByteString -> Bool 439invariant_lbs (L.Empty) = True 440invariant_lbs (L.Chunk x xs) = not (B.null x) && invariant_lbs xs 441 442prop_invariant :: (Binary a) => a -> Bool 443prop_invariant = invariant_lbs . encode 444 445-- refragment a lazy bytestring's chunks 446refragment :: [Int] -> L.ByteString -> L.ByteString 447refragment [] lbs = lbs 448refragment (x:xs) lbs = 449 let x' = fromIntegral . (+1) . abs $ x 450 rest = refragment xs (L.drop x' lbs) in 451 L.append (L.fromChunks [B.concat . L.toChunks . L.take x' $ lbs]) rest 452 453-- check identity of refragmentation 454prop_refragment :: L.ByteString -> [Int] -> Bool 455prop_refragment lbs xs = lbs == refragment xs lbs 456 457-- check that refragmention still hold invariant 458prop_refragment_inv :: L.ByteString -> [Int] -> Bool 459prop_refragment_inv lbs xs = invariant_lbs $ refragment xs lbs 460 461main :: IO () 462main = defaultMain tests 463 464------------------------------------------------------------------------ 465 466genInteger :: Gen Integer 467genInteger = do 468 b <- arbitrary 469 if b then genIntegerSmall else genIntegerSmall 470 471genIntegerSmall :: Gen Integer 472genIntegerSmall = arbitrary 473 474genIntegerBig :: Gen Integer 475genIntegerBig = do 476 x <- arbitrarySizedIntegral :: Gen Integer 477 -- arbitrarySizedIntegral generates numbers smaller than 478 -- (maxBound :: Word32), so let's make them bigger to better test 479 -- the Binary instance. 480 return (x + fromIntegral (maxBound :: Word32)) 481 482#ifdef HAS_NATURAL 483genNatural :: Gen Natural 484genNatural = do 485 b <- arbitrary 486 if b then genNaturalSmall else genNaturalBig 487 488genNaturalSmall :: Gen Natural 489genNaturalSmall = arbitrarySizedNatural 490 491genNaturalBig :: Gen Natural 492genNaturalBig = do 493 x <- arbitrarySizedNatural :: Gen Natural 494 -- arbitrarySizedNatural generates numbers smaller than 495 -- (maxBound :: Word64), so let's make them bigger to better test 496 -- the Binary instance. 497 return (x + fromIntegral (maxBound :: Word64)) 498#endif 499 500------------------------------------------------------------------------ 501 502genFingerprint :: Gen Fingerprint 503genFingerprint = liftM2 Fingerprint arbitrary arbitrary 504 505------------------------------------------------------------------------ 506 507#ifdef HAS_FIXED_CONSTRUCTOR 508 509fixedPut :: forall a. Fixed.HasResolution a => Fixed.Fixed a -> Put 510fixedPut x = put (truncate (x * fromInteger (Fixed.resolution (undefined :: Maybe a))) :: Integer) 511 512fixedGet :: forall a. Fixed.HasResolution a => Get (Fixed.Fixed a) 513fixedGet = (\x -> fromInteger x / fromInteger (Fixed.resolution (undefined :: Maybe a))) `liftA` get 514 515-- | Serialise using base >=4.7 and <4.7 methods agree 516prop_fixed_ser :: Fixed.Fixed Fixed.E3 -> Bool 517prop_fixed_ser x = runPut (put x) == runPut (fixedPut x) 518 519-- | Serialised with base >=4.7, unserialised with base <4.7 method roundtrip 520prop_fixed_constr_resolution :: Fixed.Fixed Fixed.E3 -> Bool 521prop_fixed_constr_resolution x = runGet fixedGet (runPut (put x)) == x 522 523-- | Serialised with base <4.7, unserialised with base >=4.7 method roundtrip 524prop_fixed_resolution_constr :: Fixed.Fixed Fixed.E3 -> Bool 525prop_fixed_resolution_constr x = runGet get (runPut (fixedPut x)) == x 526 527#endif 528 529------------------------------------------------------------------------ 530 531type T a = a -> Property 532type B a = a -> Bool 533 534p :: (Testable p) => p -> Property 535p = property 536 537test :: (Eq a, Binary a) => a -> Property 538test a = forAll positiveList (roundTrip a . refragment) 539 540test' :: (Show a, Arbitrary a) => String -> (a -> Property) -> ([a] -> Property) -> Test 541test' desc prop propList = 542 testGroup desc [ 543 testProperty desc prop, 544 testProperty ("[" ++ desc ++ "]") propList 545 ] 546 547testWithGen :: (Show a, Eq a, Binary a) => String -> Gen a -> Test 548testWithGen desc gen = 549 testGroup desc [ 550 testProperty desc (forAll gen test), 551 testProperty ("[" ++ desc ++ "]") (forAll (listOf gen) test) 552 ] 553 554positiveList :: Gen [Int] 555positiveList = fmap (filter (/=0) . map abs) $ arbitrary 556 557tests :: [Test] 558tests = 559 [ testGroup "Utils" 560 [ testProperty "refragment id" (p prop_refragment) 561 , testProperty "refragment invariant" (p prop_refragment_inv) 562 ] 563 564 , testGroup "Boundaries" 565 [ testProperty "read to much" (p (prop_readTooMuch :: B Word8)) 566 , testProperty "read negative length" (p (prop_getByteString_negative :: T Int)) 567 , -- Arbitrary test input 568 let testInput :: [Int] ; testInput = [0 .. 10] 569 in testProperty "look-ahead independent of chunking" (p (prop_lookAheadIndepOfChunking testInput)) 570 ] 571 572 , testGroup "Partial" 573 [ testProperty "partial" (p prop_partial) 574 , testProperty "fail" (p prop_fail) 575 , testProperty "bytesRead" (p prop_bytesRead) 576 , testProperty "partial only once" (p prop_partialOnlyOnce) 577 ] 578 579 , testGroup "Model" 580 Action.tests 581 582 , testGroup "Primitives" 583 [ testProperty "Word8" (p prop_Word8) 584 , testProperty "Word16be" (p prop_Word16be) 585 , testProperty "Word16le" (p prop_Word16le) 586 , testProperty "Word16host" (p prop_Word16host) 587 , testProperty "Word32be" (p prop_Word32be) 588 , testProperty "Word32le" (p prop_Word32le) 589 , testProperty "Word32host" (p prop_Word32host) 590 , testProperty "Word64be" (p prop_Word64be) 591 , testProperty "Word64le" (p prop_Word64le) 592 , testProperty "Word64host" (p prop_Word64host) 593 , testProperty "Wordhost" (p prop_Wordhost) 594 -- Int 595 , testProperty "Int8" (p prop_Int8) 596 , testProperty "Int16be" (p prop_Int16be) 597 , testProperty "Int16le" (p prop_Int16le) 598 , testProperty "Int16host" (p prop_Int16host) 599 , testProperty "Int32be" (p prop_Int32be) 600 , testProperty "Int32le" (p prop_Int32le) 601 , testProperty "Int32host" (p prop_Int32host) 602 , testProperty "Int64be" (p prop_Int64be) 603 , testProperty "Int64le" (p prop_Int64le) 604 , testProperty "Int64host" (p prop_Int64host) 605 , testProperty "Inthost" (p prop_Inthost) 606 -- Float/Double 607 , testProperty "Floatbe" (p prop_Floatbe) 608 , testProperty "Floatle" (p prop_Floatle) 609 , testProperty "Floathost" (p prop_Floathost) 610 , testProperty "Doublebe" (p prop_Doublebe) 611 , testProperty "Doublele" (p prop_Doublele) 612 , testProperty "Doublehost" (p prop_Doublehost) 613 ] 614 615 , testGroup "String utils" 616 [ testProperty "getLazyByteString" prop_getLazyByteString 617 , testProperty "getLazyByteStringNul" prop_getLazyByteStringNul 618 , testProperty "getLazyByteStringNul No Null" prop_getLazyByteStringNul_noNul 619 , testProperty "getRemainingLazyByteString" prop_getRemainingLazyByteString 620 ] 621 622 , testGroup "Using Binary class, refragmented ByteString" 623 [ test' "()" (test :: T () ) test 624 , test' "Bool" (test :: T Bool ) test 625 , test' "Char" (test :: T Char ) test 626 , test' "Ordering" (test :: T Ordering ) test 627 , test' "Ratio Int" (test :: T (Ratio Int)) test 628 629 , test' "Word" (test :: T Word ) test 630 , test' "Word8" (test :: T Word8 ) test 631 , test' "Word16" (test :: T Word16) test 632 , test' "Word32" (test :: T Word32) test 633 , test' "Word64" (test :: T Word64) test 634 635 , test' "Int" (test :: T Int ) test 636 , test' "Int8" (test :: T Int8 ) test 637 , test' "Int16" (test :: T Int16) test 638 , test' "Int32" (test :: T Int32) test 639 , test' "Int64" (test :: T Int64) test 640 641 , testWithGen "Integer mixed" genInteger 642 , testWithGen "Integer small" genIntegerSmall 643 , testWithGen "Integer big" genIntegerBig 644 645 , test' "Fixed" (test :: T (Fixed.Fixed Fixed.E3) ) test 646#ifdef HAS_NATURAL 647 , testWithGen "Natural mixed" genNatural 648 , testWithGen "Natural small" genNaturalSmall 649 , testWithGen "Natural big" genNaturalBig 650#endif 651 , testWithGen "GHC.Fingerprint" genFingerprint 652 653 , test' "Float" (test :: T Float ) test 654 , test' "Double" (test :: T Double) test 655 656 , test' "((), ())" (test :: T ((), ()) ) test 657 , test' "(Word8, Word32)" (test :: T (Word8, Word32) ) test 658 , test' "(Int8, Int32)" (test :: T (Int8, Int32) ) test 659 , test' "(Int32, [Int])" (test :: T (Int32, [Int]) ) test 660 , test' "Maybe Int8" (test :: T (Maybe Int8) ) test 661 , test' "Either Int8 Int16" (test :: T (Either Int8 Int16) ) test 662 663 , test' "(Int, ByteString)" 664 (test :: T (Int, B.ByteString) ) test 665 , test' "[(Int, ByteString)]" 666 (test :: T [(Int, B.ByteString)] ) test 667 668 , test' "(Maybe Int64, Bool, [Int])" 669 (test :: T (Maybe Int64, Bool, [Int])) test 670 , test' "(Maybe Word8, Bool, [Int], Either Bool Word8)" 671 (test :: T (Maybe Word8, Bool, [Int], Either Bool Word8)) test 672 , test' "(Maybe Word16, Bool, [Int], Either Bool Word16, Int)" 673 (test :: T (Maybe Word16, Bool, [Int], Either Bool Word16, Int)) test 674 675 , test' "(Int,Int,Int,Int,Int,Int)" 676 (test :: T (Int,Int,Int,Int,Int,Int)) test 677 , test' "(Int,Int,Int,Int,Int,Int,Int)" 678 (test :: T (Int,Int,Int,Int,Int,Int,Int)) test 679 , test' "(Int,Int,Int,Int,Int,Int,Int,Int)" 680 (test :: T (Int,Int,Int,Int,Int,Int,Int,Int)) test 681 , test' "(Int,Int,Int,Int,Int,Int,Int,Int,Int)" 682 (test :: T (Int,Int,Int,Int,Int,Int,Int,Int,Int)) test 683 , test' "(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int)" 684 (test :: T (Int,Int,Int,Int,Int,Int,Int,Int,Int,Int)) test 685 686 , test' "B.ByteString" (test :: T B.ByteString) test 687 , test' "L.ByteString" (test :: T L.ByteString) test 688#if MIN_VERSION_bytestring(0,10,4) 689 , test' "ShortByteString" (test :: T ShortByteString) test 690#endif 691 ] 692 693 , testGroup "Invariants" $ map (uncurry testProperty) 694 [ ("B.ByteString invariant", p (prop_invariant :: B B.ByteString )) 695 , ("[B.ByteString] invariant", p (prop_invariant :: B [B.ByteString] )) 696 , ("L.ByteString invariant", p (prop_invariant :: B L.ByteString )) 697 , ("[L.ByteString] invariant", p (prop_invariant :: B [L.ByteString] )) 698#if MIN_VERSION_bytestring(0,10,4) 699 , ("ShortByteString invariant", p (prop_invariant :: B ShortByteString )) 700 , ("[ShortByteString] invariant", p (prop_invariant :: B [ShortByteString] )) 701#endif 702 ] 703#ifdef HAS_FIXED_CONSTRUCTOR 704 , testGroup "Fixed" 705 [ testProperty "Serialisation same" $ p prop_fixed_ser 706 , testProperty "MkFixed -> HasResolution" $ p prop_fixed_constr_resolution 707 , testProperty "HasResolution -> MkFixed" $ p prop_fixed_resolution_constr 708 ] 709#endif 710 , testTypeable 711 ] 712