git.iko.soy/text
on master help sign in
Do a tiny amount of actual testing
aca6786Bryan O'Sullivan
tests/Bench.hs−3
compare with master
unifiedsplit
@@ -1,10 +1,7 @@
1−--module Bench where
2−
3import BenchUtils
1import BenchUtils
4import System.Mem
2import System.Mem
5import Control.Concurrent
3import Control.Concurrent
6import Data.Char
4import Data.Char
7−import Data.Array.IArray
8import System.CPUTime
5import System.CPUTime
9import System.IO
6import System.IO
10import System.IO.Unsafe
7import System.IO.Unsafe
tests/Properties.hs+20
@@ -4,6 +4,10 @@ import Test.QuickCheck
4import Text.Show.Functions
4import Text.Show.Functions
5
5
6import Prelude
6import Prelude
7+import Text.Printf
8+import System.Environment
9+import Control.Applicative
10+import Control.Monad
7import qualified Data.Text as T
11import qualified Data.Text as T
8import Data.Text (pack,unpack)
12import Data.Text (pack,unpack)
9import qualified Data.Text.Fusion as S
13import qualified Data.Text.Fusion as S
@@ -60,3 +64,19 @@ prop_findIndex p s = L.findIndex p s == T.findIndex p (pack s)
60prop_elemIndex c s = L.elemIndex c s == T.elemIndex c (pack s)
64prop_elemIndex c s = L.elemIndex c s == T.elemIndex c (pack s)
61prop_zipWith c s1 s2 = L.zipWith c s1 s2 == unpack (T.zipWith c (pack s1) (pack s2))
65prop_zipWith c s1 s2 = L.zipWith c s1 s2 == unpack (T.zipWith c (pack s1) (pack s2))
62prop_words s = L.words s == L.map unpack (T.words (pack s))
66prop_words s = L.words s == L.map unpack (T.words (pack s))
67+
68+main = run tests =<< getArgs
69+
70+run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()
71+run tests args = do
72+ let n = case args of
73+ [s] -> read s
74+ [] -> 100
75+ _ -> error "too many arguments"
76+ (results,passed) <- unzip <$> mapM (\(s,a) -> printf "%-40s: " s >> a n) tests
77+ printf "Passed %d tests!\n" (sum passed)
78+ when (not . and $ results) $
79+ fail "Not all tests passed!"
80+
81+tests :: [(String, Int -> IO (Bool, Int))]
82+tests = [("prop_pack_unpack", mytest prop_pack_unpack)]
tests/QuickCheckUtils.hs+66−10
@@ -1,17 +1,73 @@
1module QuickCheckUtils where
1module QuickCheckUtils where
2
2
3+import Data.List
4+import qualified Data.Text as T
5+import System.IO
6+import System.Random
3import Test.QuickCheck
7import Test.QuickCheck
4−import Test.QuickCheck.Batch
5−
6−import Data.Char
7−
8−import Data.Text
9−import Data.Text.Internal
10
8
11instance Arbitrary Char where
9instance Arbitrary Char where
12 arbitrary = oneof [choose ('\0','\55295'), choose ('\57334','\1114111')]
10 arbitrary = oneof [choose ('\0','\55295'), choose ('\57334','\1114111')]
13− coarbitrary c = variant (ord c `rem` 4)
11+ coarbitrary c = variant (fromEnum c `rem` 4)
12+
13+instance Arbitrary T.Text where
14+ arbitrary = T.pack `fmap` arbitrary
15+ coarbitrary s = coarbitrary (T.unpack s)
16+
17+debug = False
18+
19+mytest :: Testable a => a -> Int -> IO (Bool, Int)
20+mytest a n = mycheck defaultConfig
21+ { configMaxTest=n
22+ , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
23+
24+mycheck :: Testable a => Config -> a -> IO (Bool, Int)
25+mycheck config a =
26+ do rnd <- newStdGen
27+ mytests config (evaluate a) rnd 0 0 []
28+
29+mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO (Bool, Int)
30+mytests config gen rnd0 ntest nfail stamps
31+ | ntest == configMaxTest config = done "OK," ntest stamps >> return (True, ntest)
32+ | nfail == configMaxFail config = done "Arguments exhausted after" ntest stamps >> return (True, ntest)
33+ | otherwise =
34+ do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
35+ case ok result of
36+ Nothing ->
37+ mytests config gen rnd1 ntest (nfail+1) stamps
38+ Just True ->
39+ mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
40+ Just False ->
41+ putStr ( "Falsifiable after "
42+ ++ show ntest
43+ ++ " tests:\n"
44+ ++ unlines (arguments result)
45+ ) >> hFlush stdout >> return (False, ntest)
46+ where
47+ result = generate (configSize config ntest) rnd2 gen
48+ (rnd1,rnd2) = split rnd0
49+
50+done :: String -> Int -> [[String]] -> IO ()
51+done mesg ntest stamps =
52+ do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
53+ where
54+ table = display
55+ . map entry
56+ . reverse
57+ . sort
58+ . map pairLength
59+ . group
60+ . sort
61+ . filter (not . null)
62+ $ stamps
63+
64+ display [] = ".\n"
65+ display [x] = " (" ++ x ++ ").\n"
66+ display xs = ".\n" ++ unlines (map (++ ".") xs)
67+
68+ pairLength xss@(xs:_) = (length xss, xs)
69+ entry (n, xs) = percentage n ntest
70+ ++ " "
71+ ++ concat (intersperse ", " xs)
14
72
15−instance Arbitrary Text where
73+ percentage n m = show ((100 * n) `div` m) ++ "%"
16− arbitrary = pack `fmap` arbitrary
17− coarbitrary s = coarbitrary (unpack s)