blob: 45c1451eca80585cded0744edd9599e824aec438 [file] [log] [blame]
{-# LANGUAGE OverloadedStrings #-}
-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>
--
-- See license.txt for details
module EnumeratorTests.Util
( check
, equalExc
, equalError
, throwsError
, todo
, within
, genASCII
, genISO8859_1
, genUnicode
) where
import qualified Control.Exception as Exc
import Data.Bits ((.&.))
import qualified Data.ByteString as B
import Data.Char (chr)
import Data.Functor.Identity (Identity, runIdentity)
import Data.String (IsString, fromString)
import qualified Data.Text as T
import System.Timeout (timeout)
import Test.Chell
import Test.QuickCheck hiding ((.&.), within)
import Data.Enumerator (($$))
import qualified Data.Enumerator as E
check :: Eq b => E.Iteratee a Identity b -> ([a] -> Either Exc.ErrorCall b) -> [a] -> Bool
check iter plain xs = check' where
run = case runIdentity (E.run (E.enumList 1 xs $$ iter)) of
Left exc -> Left (Exc.fromException exc)
Right x -> Right x
check' = case plain xs of
Left err1 -> case run of
Right _ -> False
Left Nothing -> False
Left (Just err2) -> eqError err1 err2
Right x -> case run of
Right y -> x == y
Left _ -> False
eqError :: Exc.ErrorCall -> Exc.ErrorCall -> Bool
eqError (Exc.ErrorCall s1) (Exc.ErrorCall s2) = s1 == s2
todo :: T.Text -> Suite
todo name = skipIf True (assertions name (return ()))
genASCII :: IsString a => Gen a
genASCII = fmap fromString string where
string = sized $ \n -> do
k <- choose (0,n)
sequence [ char | _ <- [1..k] ]
char = chr `fmap` choose (0,0x7F)
genISO8859_1 :: IsString a => Gen a
genISO8859_1 = fmap fromString string where
string = sized $ \n -> do
k <- choose (0,n)
sequence [ char | _ <- [1..k] ]
char = chr `fmap` choose (0,0xFF)
genUnicode :: IsString a => Gen a
genUnicode = fmap fromString string where
string = sized $ \n -> do
k <- choose (0,n)
sequence [ char | _ <- [1..k] ]
excluding :: [a -> Bool] -> Gen a -> Gen a
excluding bad gen = loop where
loop = do
x <- gen
if or (map ($ x) bad)
then loop
else return x
reserved = [lowSurrogate, highSurrogate, noncharacter]
lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
highSurrogate c = c >= 0xD800 && c <= 0xDBFF
noncharacter c = masked == 0xFFFE || masked == 0xFFFF where
masked = c .&. 0xFFFF
ascii = choose (0,0x7F)
plane0 = choose (0xF0, 0xFFFF)
plane1 = oneof [ choose (0x10000, 0x10FFF)
, choose (0x11000, 0x11FFF)
, choose (0x12000, 0x12FFF)
, choose (0x13000, 0x13FFF)
, choose (0x1D000, 0x1DFFF)
, choose (0x1F000, 0x1FFFF)
]
plane2 = oneof [ choose (0x20000, 0x20FFF)
, choose (0x21000, 0x21FFF)
, choose (0x22000, 0x22FFF)
, choose (0x23000, 0x23FFF)
, choose (0x24000, 0x24FFF)
, choose (0x25000, 0x25FFF)
, choose (0x26000, 0x26FFF)
, choose (0x27000, 0x27FFF)
, choose (0x28000, 0x28FFF)
, choose (0x29000, 0x29FFF)
, choose (0x2A000, 0x2AFFF)
, choose (0x2B000, 0x2BFFF)
, choose (0x2F000, 0x2FFFF)
]
plane14 = choose (0xE0000, 0xE0FFF)
planes = [ascii, plane0, plane1, plane2, plane14]
char = chr `fmap` excluding reserved (oneof planes)
instance Arbitrary a => Arbitrary (E.Stream a) where
arbitrary = frequency
[ (10, return E.EOF)
, (90, fmap E.Chunks arbitrary)
]
instance Arbitrary T.Text where
arbitrary = genUnicode
instance Arbitrary B.ByteString where
arbitrary = genUnicode
-- | Require a test to complete within /n/ milliseconds.
within :: Int -> Suite -> Suite
within time s = suite (suiteName s) (map wrapTest (suiteTests s)) where
wrapTest (Test name io) = test $ Test name $ \opts -> do
res <- timeout (time * 1000) (io opts)
case res of
Just res' -> return res'
Nothing -> return (TestAborted [] (T.pack ("Test timed out after " ++ show time ++ " milliseconds")))
equalExc :: (Eq exc, Exc.Exception exc) => exc -> Either Exc.SomeException a -> Assertion
equalExc expected funResult = Assertion (return result) where
failed :: String -> AssertionResult
failed str = AssertionFailed (T.pack ("equalExc: " ++ show str))
result = case funResult of
Right _ -> failed "received Right"
Left exc -> case Exc.fromException exc of
Nothing -> failed ("received unexpected exception: " ++ show exc)
Just exc' -> if expected == exc'
then AssertionPassed
else failed (show expected ++ " /= " ++ show exc')
equalError :: Exc.ErrorCall -> Either Exc.SomeException a -> Assertion
equalError expected funResult = Assertion (return result) where
failed :: String -> AssertionResult
failed str = AssertionFailed (T.pack ("equalError: " ++ show str))
result = case funResult of
Right _ -> failed "received Right"
Left exc -> case Exc.fromException exc of
Nothing -> failed ("received unexpected exception: " ++ show exc)
Just exc' -> if eqError expected exc'
then AssertionPassed
else failed (show expected ++ " /= " ++ show exc')
throwsError :: Exc.ErrorCall -> IO a -> Assertion
throwsError err = throws (eqError err)