on master help sign in
Much tidying up of tests:
c782d2dBryan O'Sullivan
tests/Makefile+7−5
@@ -1,7 +1,9 @@
1version := $(shell awk '/^version:/{print $$2}' ../text.cabal)
1version := $(shell awk '/^version:/{print $$2}' ../text.cabal)
2ghc := ghc
2ghc := ghc
3−ghc-base-flags := -O -funbox-strict-fields -package bytestring \
3+ghc-base-flags := -O -funbox-strict-fields \
4+ -package bytestring -package QuickCheck -package test-framework \
4− -package QuickCheck -ignore-package text
5+ -package test-framework-quickcheck -ignore-package text \
6+ghc-base-flags += -Wall -fno-warn-orphans -fno-warn-missing-signatures
5ghc-flags := $(ghc-base-flags) -i../dist/build -package-name text-$(version)
7ghc-flags := $(ghc-base-flags) -i../dist/build -package-name text-$(version)
6ghc-hpc-flags := $(ghc-base-flags) -fhpc -fno-ignore-asserts -odir hpcdir \
8ghc-hpc-flags := $(ghc-base-flags) -fhpc -fno-ignore-asserts -odir hpcdir \
7 -hidir hpcdir -i..
9 -hidir hpcdir -i..
@@ -29,17 +31,17 @@ Properties.o: QuickCheckUtils.o
29QuickCheckUtils.o: $(lib)
31QuickCheckUtils.o: $(lib)
30
32
31qc: Properties.o QuickCheckUtils.o
33qc: Properties.o QuickCheckUtils.o
32− $(ghc) $(ghc-flags) -o $@ $^ $(lib)
34+ $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)
33
35
34qc-hpc: Properties.hs QuickCheckUtils.hs $(lib-srcs:%=../%)
36qc-hpc: Properties.hs QuickCheckUtils.hs $(lib-srcs:%=../%)
35 -mkdir -p hpcdir
37 -mkdir -p hpcdir
36 @rm -f $@.tix
38 @rm -f $@.tix
37− $(ghc) $(ghc-hpc-flags) -ihpcdir --make -o $@ $<
39+ $(ghc) $(ghc-hpc-flags) -ihpcdir --make -threaded -o $@ $<
38
40
39coverage: qc-hpc-html/hpc_index.html
41coverage: qc-hpc-html/hpc_index.html
40
42
41qc-hpc-html/hpc_index.html: qc-hpc
43qc-hpc-html/hpc_index.html: qc-hpc
42− ./qc-hpc 500
44+ ./qc-hpc -a 500 +RTS -N2
43 hpc markup qc-hpc --exclude=Main --exclude=Properties \
45 hpc markup qc-hpc --exclude=Main --exclude=Properties \
44 --exclude=QuickCheckUtils --srcdir=.. --srcdir=. --destdir=$(dir $@)
46 --exclude=QuickCheckUtils --srcdir=.. --srcdir=. --destdir=$(dir $@)
45
47
tests/Properties.hs+309−284
@@ -3,33 +3,29 @@
3{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
3{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
4
4
5import Test.QuickCheck
5import Test.QuickCheck
6−import Text.Show.Functions
6+import Text.Show.Functions ()
7−
7+
8−import Data.Char
8+import Data.Char (chr, isLower, isSpace, isUpper, ord)
9−import Data.Monoid
9+import Data.Monoid (Monoid(..))
10−import Data.String
10+import Data.String (fromString)
11−import Debug.Trace
11+import Debug.Trace (trace)
12−import Text.Printf
13−import System.Environment
14−import Control.Applicative
15−import Control.Arrow
12+import Control.Arrow ((***), second)
16−import Control.Monad
17−import Data.Word
13+import Data.Word (Word8)
18−import qualified Data.ByteString as B
19import qualified Data.Text as T
14import qualified Data.Text as T
20import qualified Data.Text.Compat as C
15import qualified Data.Text.Compat as C
21import qualified Data.Text.Lazy as TL
16import qualified Data.Text.Lazy as TL
22import qualified Data.Text.Encoding as E
17import qualified Data.Text.Encoding as E
23−import Control.Exception
18+import Control.Exception (SomeException, try)
24import qualified Data.Text.Fusion as S
19import qualified Data.Text.Fusion as S
25import qualified Data.Text.Fusion.Common as S
20import qualified Data.Text.Fusion.Common as S
26import qualified Data.Text.Lazy.Encoding as EL
21import qualified Data.Text.Lazy.Encoding as EL
27import qualified Data.Text.Lazy.Fusion as SL
22import qualified Data.Text.Lazy.Fusion as SL
28import qualified Data.List as L
23import qualified Data.List as L
29−import System.IO.Unsafe
24+import System.IO.Unsafe (unsafePerformIO)
30−import Prelude hiding (catch)
25+import Test.Framework (defaultMain, testGroup)
26+import Test.Framework.Providers.QuickCheck (testProperty)
31
27
32−import QuickCheckUtils
28+import QuickCheckUtils ()
33
29
34-- Ensure that two potentially bottom values (in the sense of crashing
30-- Ensure that two potentially bottom values (in the sense of crashing
35-- for some inputs, not looping infinitely) either both crash, or both
31-- for some inputs, not looping infinitely) either both crash, or both
@@ -46,9 +42,6 @@ i =^= j = unsafePerformIO $ do
46 e -> trace ("*** Divergence: " ++ show e) return False
42 e -> trace ("*** Divergence: " ++ show e) return False
47infix 4 =^=
43infix 4 =^=
48
44
49−tracer f a = let r = f a
50− in trace (show r) r
51−
52prop_T_pack_unpack = (T.unpack . T.pack) `eq` id
45prop_T_pack_unpack = (T.unpack . T.pack) `eq` id
53prop_TL_pack_unpack = (TL.unpack . TL.pack) `eq` id
46prop_TL_pack_unpack = (TL.unpack . TL.pack) `eq` id
54prop_T_stream_unstream = (S.unstream . S.stream) `eq` id
47prop_T_stream_unstream = (S.unstream . S.stream) `eq` id
@@ -104,10 +97,10 @@ eq a b s = a s =^= b s
104-- What about with the RHS packed?
97-- What about with the RHS packed?
105eqP :: (Eq a, Show a, Stringy s) =>
98eqP :: (Eq a, Show a, Stringy s) =>
106 (String -> a) -> (s -> a) -> String -> Word8 -> Bool
99 (String -> a) -> (s -> a) -> String -> Word8 -> Bool
107−eqP a b s w = eq "orig" (a s) (b t) &&
100+eqP f g s w = eql "orig" (f s) (g t) &&
108− eq "mini" (a s) (b mini) &&
101+ eql "mini" (f s) (g mini) &&
109− eq "head" (a sa) (b ta) &&
102+ eql "head" (f sa) (g ta) &&
110− eq "tail" (a sb) (b tb)
103+ eql "tail" (f sb) (g tb)
111 where t = packS s
104 where t = packS s
112 mini = packSChunkSize 10 s
105 mini = packSChunkSize 10 s
113 (sa,sb) = splitAt m s
106 (sa,sb) = splitAt m s
@@ -116,14 +109,14 @@ eqP a b s w = eq "orig" (a s) (b t) &&
116 m | l == 0 = n
109 m | l == 0 = n
117 | otherwise = n `mod` l
110 | otherwise = n `mod` l
118 n = fromIntegral w
111 n = fromIntegral w
119− eq s a b | a =^= b = True
112+ eql d a b | a =^= b = True
120− | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False
113+ | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
121
114
122-- For tests that have O(n^2) running times or input sizes, resize
115-- For tests that have O(n^2) running times or input sizes, resize
123-- their inputs to the square root of the originals.
116-- their inputs to the square root of the originals.
124unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
117unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
125unsquare = forAll . sized $ \n -> resize (smaller n) arbitrary
118unsquare = forAll . sized $ \n -> resize (smaller n) arbitrary
126− where smaller = round . sqrt . fromIntegral
119+ where smaller = round . (sqrt :: Double -> Double) . fromIntegral
127
120
128prop_S_Eq s = (s==) `eq` ((S.stream s==) . S.stream)
121prop_S_Eq s = (s==) `eq` ((S.stream s==) . S.stream)
129prop_T_Eq s = (s==) `eq` ((T.pack s==) . T.pack)
122prop_T_Eq s = (s==) `eq` ((T.pack s==) . T.pack)
@@ -155,9 +148,9 @@ uncons (x:xs) = Just (x,xs)
155uncons _ = Nothing
148uncons _ = Nothing
156
149
157prop_T_uncons s = uncons `eqP` (fmap (second unpackS) . T.uncons)
150prop_T_uncons s = uncons `eqP` (fmap (second unpackS) . T.uncons)
158− where types = s :: String
151+ where _types = s :: String
159prop_TL_uncons s = uncons `eqP` (fmap (second unpackS) . TL.uncons)
152prop_TL_uncons s = uncons `eqP` (fmap (second unpackS) . TL.uncons)
160− where types = s :: String
153+ where _types = s :: String
161prop_S_head = head `eqP` S.head
154prop_S_head = head `eqP` S.head
162prop_T_head = head `eqP` T.head
155prop_T_head = head `eqP` T.head
163prop_TL_head = head `eqP` TL.head
156prop_TL_head = head `eqP` TL.head
@@ -198,7 +191,7 @@ split pat src0
198 l = length pat
191 l = length pat
199 go src = search 0 src
192 go src = search 0 src
200 where
193 where
201− search !n [] = [src]
194+ search _ [] = [src]
202 search !n s@(_:s')
195 search !n s@(_:s')
203 | pat `L.isPrefixOf` s = take n src : go (drop l s)
196 | pat `L.isPrefixOf` s = take n src : go (drop l s)
204 | otherwise = search (n+1) s'
197 | otherwise = search (n+1) s'
@@ -216,24 +209,24 @@ justifyLeft k c s = s ++ replicate (k - length s) c
216prop_S_justifyLeft k c = justifyLeft k c `eqP` (unpackS . S.justifyLeft k c)
209prop_S_justifyLeft k c = justifyLeft k c `eqP` (unpackS . S.justifyLeft k c)
217prop_T_justifyLeft k c = justifyLeft k c `eqP` (unpackS . T.justifyLeft k c)
210prop_T_justifyLeft k c = justifyLeft k c `eqP` (unpackS . T.justifyLeft k c)
218prop_T_justifyRight k c = jr k c `eqP` (unpackS . T.justifyRight k c)
211prop_T_justifyRight k c = jr k c `eqP` (unpackS . T.justifyRight k c)
219− where jr k c s = replicate (k - length s) c ++ s
212+ where jr m n s = replicate (m - length s) n ++ s
220
213
221prop_T_foldl f z = L.foldl f z `eqP` (T.foldl f z)
214prop_T_foldl f z = L.foldl f z `eqP` (T.foldl f z)
222− where types = f :: Char -> Char -> Char
215+ where _types = f :: Char -> Char -> Char
223prop_TL_foldl f z = L.foldl f z `eqP` (TL.foldl f z)
216prop_TL_foldl f z = L.foldl f z `eqP` (TL.foldl f z)
224− where types = f :: Char -> Char -> Char
217+ where _types = f :: Char -> Char -> Char
225prop_T_foldl' f z = L.foldl' f z `eqP` T.foldl' f z
218prop_T_foldl' f z = L.foldl' f z `eqP` T.foldl' f z
226− where types = f :: Char -> Char -> Char
219+ where _types = f :: Char -> Char -> Char
227prop_TL_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z
220prop_TL_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z
228− where types = f :: Char -> Char -> Char
221+ where _types = f :: Char -> Char -> Char
229prop_T_foldl1 f = L.foldl1 f `eqP` T.foldl1 f
222prop_T_foldl1 f = L.foldl1 f `eqP` T.foldl1 f
230prop_TL_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f
223prop_TL_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f
231prop_T_foldl1' f = L.foldl1' f `eqP` T.foldl1' f
224prop_T_foldl1' f = L.foldl1' f `eqP` T.foldl1' f
232prop_TL_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f
225prop_TL_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f
233prop_T_foldr f z = L.foldr f z `eqP` T.foldr f z
226prop_T_foldr f z = L.foldr f z `eqP` T.foldr f z
234− where types = f :: Char -> Char -> Char
227+ where _types = f :: Char -> Char -> Char
235prop_TL_foldr f z = L.foldr f z `eqP` TL.foldr f z
228prop_TL_foldr f z = L.foldr f z `eqP` TL.foldr f z
236− where types = f :: Char -> Char -> Char
229+ where _types = f :: Char -> Char -> Char
237prop_T_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
230prop_T_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
238prop_TL_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
231prop_TL_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f
239
232
@@ -260,13 +253,13 @@ prop_T_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)
260prop_TL_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)
253prop_TL_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)
261
254
262prop_T_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z))
255prop_T_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z))
263− where types = f :: Int -> Char -> (Int,Char)
256+ where _types = f :: Int -> Char -> (Int,Char)
264prop_TL_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z))
257prop_TL_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z))
265− where types = f :: Int -> Char -> (Int,Char)
258+ where _types = f :: Int -> Char -> (Int,Char)
266prop_T_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z))
259prop_T_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z))
267− where types = f :: Int -> Char -> (Int,Char)
260+ where _types = f :: Int -> Char -> (Int,Char)
268prop_TL_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z))
261prop_TL_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z))
269− where types = f :: Int -> Char -> (Int,Char)
262+ where _types = f :: Int -> Char -> (Int,Char)
270
263
271prop_T_replicate n = L.replicate n `eq` (unpackS . T.replicate n)
264prop_T_replicate n = L.replicate n `eq` (unpackS . T.replicate n)
272prop_TL_replicate n = L.replicate n `eq` (unpackS . TL.replicate n)
265prop_TL_replicate n = L.replicate n `eq` (unpackS . TL.replicate n)
@@ -426,248 +419,280 @@ shorten n t@(S.Stream arr off len)
426 | n < len && n > 0 = S.Stream arr off n
419 | n < len && n > 0 = S.Stream arr off n
427 | otherwise = t
420 | otherwise = t
428
421
429−main = run tests =<< getArgs
422+main = defaultMain tests
430−
423+
431−run :: [(String, Int -> IO (Bool,Int))] -> [String] -> IO ()
432−run tests args = do
433− let (n,names) = case args of
434− (k:ts) -> (read k,ts)
435− [] -> (100,[])
436− (results,passed) <- fmap unzip . forM tests $ \(s,a) ->
437− if null names || s `elem` names
438− then printf "%-40s: " s >> a n
439− else return (True,0)
440− printf "Passed %d tests!\n" (sum passed)
441− when (not . and $ results) $
442− fail "Not all tests passed!"
443−
444−tests :: [(String, Int -> IO (Bool, Int))]
445tests = [
424tests = [
425+ testGroup "creation/elimination" [
446− ("prop_T_pack_unpack", mytest prop_T_pack_unpack),
426+ testProperty "t_pack_unpack" prop_T_pack_unpack,
447− ("prop_TL_pack_unpack", mytest prop_TL_pack_unpack),
427+ testProperty "tl_pack_unpack" prop_TL_pack_unpack,
448− ("prop_T_stream_unstream", mytest prop_T_stream_unstream),
428+ testProperty "t_stream_unstream" prop_T_stream_unstream,
449− ("prop_TL_stream_unstream", mytest prop_TL_stream_unstream),
429+ testProperty "tl_stream_unstream" prop_TL_stream_unstream,
450− ("prop_T_reverse_stream", mytest prop_T_reverse_stream),
430+ testProperty "t_reverse_stream" prop_T_reverse_stream,
451− ("prop_T_singleton", mytest prop_T_singleton),
431+ testProperty "t_singleton" prop_T_singleton,
452− ("prop_TL_singleton", mytest prop_TL_singleton),
432+ testProperty "tl_singleton" prop_TL_singleton,
453− ("prop_TL_unstreamChunks", mytest prop_TL_unstreamChunks),
433+ testProperty "tl_unstreamChunks" prop_TL_unstreamChunks,
454− ("prop_TL_chunk_unchunk", mytest prop_TL_chunk_unchunk),
434+ testProperty "tl_chunk_unchunk" prop_TL_chunk_unchunk
455−
435+ ],
456− ("prop_T_ascii", mytest prop_T_ascii),
436+
457− ("prop_T_utf8", mytest prop_T_utf8),
437+ testGroup "transcoding" [
458− ("prop_TL_utf8", mytest prop_TL_utf8),
438+ testProperty "t_ascii" prop_T_ascii,
439+ testProperty "t_utf8" prop_T_utf8,
440+ testProperty "tl_utf8" prop_TL_utf8,
459− ("prop_T_utf16LE", mytest prop_T_utf16LE),
441+ testProperty "t_utf16LE" prop_T_utf16LE,
460− ("prop_T_utf16BE", mytest prop_T_utf16BE),
442+ testProperty "t_utf16BE" prop_T_utf16BE,
461− ("prop_T_utf32LE", mytest prop_T_utf32LE),
443+ testProperty "t_utf32LE" prop_T_utf32LE,
462− ("prop_T_utf32BE", mytest prop_T_utf32BE),
444+ testProperty "t_utf32BE" prop_T_utf32BE
463−
445+ ],
464− ("prop_S_Eq", mytest prop_S_Eq),
446+
465− ("prop_T_Eq", mytest prop_T_Eq),
447+ testGroup "instances" [
466− ("prop_TL_Eq", mytest prop_TL_Eq),
448+ testProperty "s_Eq" prop_S_Eq,
467− ("prop_S_Ord", mytest prop_S_Ord),
449+ testProperty "t_Eq" prop_T_Eq,
468− ("prop_T_Ord", mytest prop_T_Ord),
450+ testProperty "tl_Eq" prop_TL_Eq,
469− ("prop_TL_Ord", mytest prop_TL_Ord),
451+ testProperty "s_Ord" prop_S_Ord,
470− ("prop_T_Read", mytest prop_T_Read),
452+ testProperty "t_Ord" prop_T_Ord,
471− ("prop_TL_Read", mytest prop_TL_Read),
453+ testProperty "tl_Ord" prop_TL_Ord,
472− ("prop_T_Show", mytest prop_T_Show),
454+ testProperty "t_Read" prop_T_Read,
473− ("prop_TL_Show", mytest prop_TL_Show),
455+ testProperty "tl_Read" prop_TL_Read,
456+ testProperty "t_Show" prop_T_Show,
457+ testProperty "tl_Show" prop_TL_Show,
474− ("prop_T_mappend", mytest prop_T_mappend),
458+ testProperty "t_mappend" prop_T_mappend,
475− ("prop_TL_mappend", mytest prop_TL_mappend),
459+ testProperty "tl_mappend" prop_TL_mappend,
476− ("prop_T_mconcat", mytest prop_T_mconcat),
460+ testProperty "t_mconcat" prop_T_mconcat,
477− ("prop_TL_mconcat", mytest prop_TL_mconcat),
461+ testProperty "tl_mconcat" prop_TL_mconcat,
478− ("prop_T_IsString", mytest prop_T_IsString),
462+ testProperty "t_IsString" prop_T_IsString,
479− ("prop_TL_IsString", mytest prop_TL_IsString),
463+ testProperty "tl_IsString" prop_TL_IsString
480−
464+ ],
481− ("prop_S_cons", mytest prop_S_cons),
465+
482− ("prop_T_cons", mytest prop_T_cons),
466+ testGroup "basics" [
483− ("prop_TL_cons", mytest prop_TL_cons),
467+ testProperty "s_cons" prop_S_cons,
484− ("prop_S_snoc", mytest prop_S_snoc),
468+ testProperty "t_cons" prop_T_cons,
485− ("prop_T_snoc", mytest prop_T_snoc),
469+ testProperty "tl_cons" prop_TL_cons,
486− ("prop_TL_snoc", mytest prop_TL_snoc),
470+ testProperty "s_snoc" prop_S_snoc,
471+ testProperty "t_snoc" prop_T_snoc,
472+ testProperty "tl_snoc" prop_TL_snoc,
487− ("prop_T_append", mytest prop_T_append),
473+ testProperty "t_append" prop_T_append,
488− ("prop_T_appendS", mytest prop_T_appendS),
474+ testProperty "t_appendS" prop_T_appendS,
489− ("prop_T_uncons", mytest prop_T_uncons),
475+ testProperty "t_uncons" prop_T_uncons,
490− ("prop_TL_uncons", mytest prop_TL_uncons),
476+ testProperty "tl_uncons" prop_TL_uncons,
491− ("prop_S_head", mytest prop_S_head),
477+ testProperty "s_head" prop_S_head,
492− ("prop_T_head", mytest prop_T_head),
478+ testProperty "t_head" prop_T_head,
493− ("prop_TL_head", mytest prop_TL_head),
479+ testProperty "tl_head" prop_TL_head,
494− ("prop_S_last", mytest prop_S_last),
480+ testProperty "s_last" prop_S_last,
495− ("prop_T_last", mytest prop_T_last),
481+ testProperty "t_last" prop_T_last,
496− ("prop_TL_last", mytest prop_TL_last),
482+ testProperty "tl_last" prop_TL_last,
497− ("prop_S_tail", mytest prop_S_tail),
483+ testProperty "s_tail" prop_S_tail,
498− ("prop_T_tail", mytest prop_T_tail),
484+ testProperty "t_tail" prop_T_tail,
499− ("prop_TL_tail", mytest prop_TL_tail),
485+ testProperty "tl_tail" prop_TL_tail,
500− ("prop_S_init", mytest prop_S_init),
486+ testProperty "s_init" prop_S_init,
501− ("prop_T_init", mytest prop_T_init),
487+ testProperty "t_init" prop_T_init,
502− ("prop_TL_init", mytest prop_TL_init),
488+ testProperty "tl_init" prop_TL_init,
503− ("prop_S_null", mytest prop_S_null),
489+ testProperty "s_null" prop_S_null,
504− ("prop_T_null", mytest prop_T_null),
490+ testProperty "t_null" prop_T_null,
505− ("prop_TL_null", mytest prop_TL_null),
491+ testProperty "tl_null" prop_TL_null,
506− ("prop_S_length", mytest prop_S_length),
492+ testProperty "s_length" prop_S_length,
507− ("prop_T_length", mytest prop_T_length),
493+ testProperty "t_length" prop_T_length,
508− ("prop_TL_length", mytest prop_TL_length),
494+ testProperty "tl_length" prop_TL_length
509−
495+ ],
510− ("prop_T_map", mytest prop_T_map),
496+
511− ("prop_TL_map", mytest prop_TL_map),
497+ testGroup "transformations" [
498+ testProperty "t_map" prop_T_map,
499+ testProperty "tl_map" prop_TL_map,
512− ("prop_T_intercalate", mytest prop_T_intercalate),
500+ testProperty "t_intercalate" prop_T_intercalate,
513− ("prop_TL_intercalate", mytest prop_TL_intercalate),
501+ testProperty "tl_intercalate" prop_TL_intercalate,
514− ("prop_T_intersperse", mytest prop_T_intersperse),
502+ testProperty "t_intersperse" prop_T_intersperse,
515− ("prop_TL_intersperse", mytest prop_TL_intersperse),
503+ testProperty "tl_intersperse" prop_TL_intersperse,
516− ("prop_T_transpose", mytest prop_T_transpose),
504+ testProperty "t_transpose" prop_T_transpose,
517− ("prop_TL_transpose", mytest prop_TL_transpose),
505+ testProperty "tl_transpose" prop_TL_transpose,
518− ("prop_T_reverse", mytest prop_T_reverse),
506+ testProperty "t_reverse" prop_T_reverse,
519− ("prop_TL_reverse", mytest prop_TL_reverse),
507+ testProperty "tl_reverse" prop_TL_reverse,
520− ("prop_T_reverse_short", mytest prop_T_reverse_short),
508+ testProperty "t_reverse_short" prop_T_reverse_short,
521− ("prop_T_replace", mytest prop_T_replace),
509+ testProperty "t_replace" prop_T_replace,
522−
510+
511+ testGroup "case conversion" [
523− ("prop_T_toCaseFold_length", mytest prop_T_toCaseFold_length),
512+ testProperty "t_toCaseFold_length" prop_T_toCaseFold_length,
524− ("prop_T_toLower_length", mytest prop_T_toLower_length),
513+ testProperty "t_toLower_length" prop_T_toLower_length,
525− ("prop_T_toLower_lower", mytest prop_T_toLower_lower),
514+ testProperty "t_toLower_lower" prop_T_toLower_lower,
526− ("prop_T_toUpper_length", mytest prop_T_toUpper_length),
515+ testProperty "t_toUpper_length" prop_T_toUpper_length,
527− ("prop_T_toUpper_upper", mytest prop_T_toUpper_upper),
516+ testProperty "t_toUpper_upper" prop_T_toUpper_upper
528−
517+ ],
518+
519+ testGroup "justification" [
529− ("prop_S_justifyLeft", mytest prop_S_justifyLeft),
520+ testProperty "s_justifyLeft" prop_S_justifyLeft,
530− ("prop_T_justifyLeft", mytest prop_T_justifyLeft),
521+ testProperty "t_justifyLeft" prop_T_justifyLeft,
531− ("prop_T_justifyRight", mytest prop_T_justifyRight),
522+ testProperty "t_justifyRight" prop_T_justifyRight
532−
523+ ]
533− ("prop_T_foldl", mytest prop_T_foldl),
524+ ],
525+
526+ testGroup "folds" [
527+ testProperty "t_foldl" prop_T_foldl,
534− ("prop_TL_foldl", mytest prop_TL_foldl),
528+ testProperty "tl_foldl" prop_TL_foldl,
535− ("prop_T_foldl'", mytest prop_T_foldl'),
529+ testProperty "t_foldl'" prop_T_foldl',
536− ("prop_TL_foldl'", mytest prop_TL_foldl'),
530+ testProperty "tl_foldl'" prop_TL_foldl',
537− ("prop_T_foldl1", mytest prop_T_foldl1),
531+ testProperty "t_foldl1" prop_T_foldl1,
538− ("prop_TL_foldl1", mytest prop_TL_foldl1),
532+ testProperty "tl_foldl1" prop_TL_foldl1,
539− ("prop_T_foldl1'", mytest prop_T_foldl1'),
533+ testProperty "t_foldl1'" prop_T_foldl1',
540− ("prop_TL_foldl1'", mytest prop_TL_foldl1'),
534+ testProperty "tl_foldl1'" prop_TL_foldl1',
541− ("prop_T_foldr", mytest prop_T_foldr),
535+ testProperty "t_foldr" prop_T_foldr,
542− ("prop_TL_foldr", mytest prop_TL_foldr),
536+ testProperty "tl_foldr" prop_TL_foldr,
543− ("prop_T_foldr1", mytest prop_T_foldr1),
537+ testProperty "t_foldr1" prop_T_foldr1,
544− ("prop_TL_foldr1", mytest prop_TL_foldr1),
538+ testProperty "tl_foldr1" prop_TL_foldr1,
545−
539+
540+ testGroup "special" [
546− ("prop_T_concat", mytest prop_T_concat),
541+ testProperty "t_concat" prop_T_concat,
547− ("prop_TL_concat", mytest prop_TL_concat),
542+ testProperty "tl_concat" prop_TL_concat,
548− ("prop_T_concatMap", mytest prop_T_concatMap),
543+ testProperty "t_concatMap" prop_T_concatMap,
549− ("prop_TL_concatMap", mytest prop_TL_concatMap),
544+ testProperty "tl_concatMap" prop_TL_concatMap,
550− ("prop_T_any", mytest prop_T_any),
545+ testProperty "t_any" prop_T_any,
551− ("prop_TL_any", mytest prop_TL_any),
546+ testProperty "tl_any" prop_TL_any,
552− ("prop_T_all", mytest prop_T_all),
547+ testProperty "t_all" prop_T_all,
553− ("prop_TL_all", mytest prop_TL_all),
548+ testProperty "tl_all" prop_TL_all,
554− ("prop_T_maximum", mytest prop_T_maximum),
549+ testProperty "t_maximum" prop_T_maximum,
555− ("prop_TL_maximum", mytest prop_TL_maximum),
550+ testProperty "tl_maximum" prop_TL_maximum,
556− ("prop_T_minimum", mytest prop_T_minimum),
551+ testProperty "t_minimum" prop_T_minimum,
557− ("prop_TL_minimum", mytest prop_TL_minimum),
552+ testProperty "tl_minimum" prop_TL_minimum
558−
553+ ]
559− ("prop_T_scanl", mytest prop_T_scanl),
554+ ],
555+
556+ testGroup "construction" [
557+ testGroup "scans" [
558+ testProperty "t_scanl" prop_T_scanl,
560− ("prop_TL_scanl", mytest prop_TL_scanl),
559+ testProperty "tl_scanl" prop_TL_scanl,
561− ("prop_T_scanl1", mytest prop_T_scanl1),
560+ testProperty "t_scanl1" prop_T_scanl1,
562− ("prop_TL_scanl1", mytest prop_TL_scanl1),
561+ testProperty "tl_scanl1" prop_TL_scanl1,
563− ("prop_T_scanr", mytest prop_T_scanr),
562+ testProperty "t_scanr" prop_T_scanr,
564− ("prop_TL_scanr", mytest prop_TL_scanr),
563+ testProperty "tl_scanr" prop_TL_scanr,
565− ("prop_T_scanr1", mytest prop_T_scanr1),
564+ testProperty "t_scanr1" prop_T_scanr1,
566− ("prop_TL_scanr1", mytest prop_TL_scanr1),
565+ testProperty "tl_scanr1" prop_TL_scanr1
567−
566+ ],
567+
568+ testGroup "mapAccum" [
568− ("prop_T_mapAccumL", mytest prop_T_mapAccumL),
569+ testProperty "t_mapAccumL" prop_T_mapAccumL,
569− ("prop_TL_mapAccumL", mytest prop_TL_mapAccumL),
570+ testProperty "tl_mapAccumL" prop_TL_mapAccumL,
570− ("prop_T_mapAccumR", mytest prop_T_mapAccumR),
571+ testProperty "t_mapAccumR" prop_T_mapAccumR,
571− ("prop_TL_mapAccumR", mytest prop_TL_mapAccumR),
572+ testProperty "tl_mapAccumR" prop_TL_mapAccumR
572−
573+ ],
574+
575+ testGroup "unfolds" [
573− ("prop_T_replicate", mytest prop_T_replicate),
576+ testProperty "t_replicate" prop_T_replicate,
574− ("prop_TL_replicate", mytest prop_TL_replicate),
577+ testProperty "tl_replicate" prop_TL_replicate,
575− ("prop_T_unfoldr", mytest prop_T_unfoldr),
578+ testProperty "t_unfoldr" prop_T_unfoldr,
576− ("prop_TL_unfoldr", mytest prop_TL_unfoldr),
579+ testProperty "tl_unfoldr" prop_TL_unfoldr,
577− ("prop_T_unfoldrN", mytest prop_T_unfoldrN),
580+ testProperty "t_unfoldrN" prop_T_unfoldrN,
578− ("prop_TL_unfoldrN", mytest prop_TL_unfoldrN),
581+ testProperty "tl_unfoldrN" prop_TL_unfoldrN
579−
582+ ]
580− ("prop_S_take", mytest prop_S_take),
583+ ],
581− ("prop_T_take", mytest prop_T_take),
584+
582− ("prop_TL_take", mytest prop_TL_take),
585+ testGroup "substrings" [
583− ("prop_S_drop", mytest prop_S_drop),
586+ testGroup "breaking" [
584− ("prop_T_drop", mytest prop_T_drop),
587+ testProperty "s_take" prop_S_take,
585− ("prop_TL_drop", mytest prop_TL_drop),
588+ testProperty "t_take" prop_T_take,
589+ testProperty "tl_take" prop_TL_take,
590+ testProperty "s_drop" prop_S_drop,
591+ testProperty "t_drop" prop_T_drop,
592+ testProperty "tl_drop" prop_TL_drop,
586− ("prop_S_takeWhile", mytest prop_S_takeWhile),
593+ testProperty "s_takeWhile" prop_S_takeWhile,
587− ("prop_T_takeWhile", mytest prop_T_takeWhile),
594+ testProperty "t_takeWhile" prop_T_takeWhile,
588− ("prop_TL_takeWhile", mytest prop_TL_takeWhile),
595+ testProperty "tl_takeWhile" prop_TL_takeWhile,
589− ("prop_S_dropWhile", mytest prop_S_dropWhile),
596+ testProperty "s_dropWhile" prop_S_dropWhile,
590− ("prop_T_dropWhile", mytest prop_T_dropWhile),
597+ testProperty "t_dropWhile" prop_T_dropWhile,
591− ("prop_TL_dropWhile", mytest prop_TL_dropWhile),
598+ testProperty "tl_dropWhile" prop_TL_dropWhile,
592− ("prop_S_dropWhileEnd", mytest prop_S_dropWhileEnd),
599+ testProperty "s_dropWhileEnd" prop_S_dropWhileEnd,
593− ("prop_T_dropWhileEnd", mytest prop_T_dropWhileEnd),
600+ testProperty "t_dropWhileEnd" prop_T_dropWhileEnd,
594− ("prop_T_dropAround", mytest prop_T_dropAround),
601+ testProperty "t_dropAround" prop_T_dropAround,
595− ("prop_T_stripStart", mytest prop_T_stripStart),
602+ testProperty "t_stripStart" prop_T_stripStart,
596− ("prop_T_stripEnd", mytest prop_T_stripEnd),
603+ testProperty "t_stripEnd" prop_T_stripEnd,
597− ("prop_T_strip", mytest prop_T_strip),
604+ testProperty "t_strip" prop_T_strip,
598− ("prop_T_splitAt", mytest prop_T_splitAt),
605+ testProperty "t_splitAt" prop_T_splitAt,
599− ("prop_T_span", mytest prop_T_span),
606+ testProperty "tl_splitAt" prop_TL_splitAt,
600− ("prop_TL_span", mytest prop_TL_span),
607+ testProperty "t_span" prop_T_span,
601− ("prop_T_break", mytest prop_T_break),
608+ testProperty "tl_span" prop_TL_span,
609+ testProperty "t_break" prop_T_break,
602− ("prop_TL_break", mytest prop_TL_break),
610+ testProperty "tl_break" prop_TL_break,
603− ("prop_T_group", mytest prop_T_group),
611+ testProperty "t_group" prop_T_group,
604− ("prop_TL_group", mytest prop_TL_group),
612+ testProperty "tl_group" prop_TL_group,
605− ("prop_T_groupBy", mytest prop_T_groupBy),
613+ testProperty "t_groupBy" prop_T_groupBy,
606− ("prop_TL_groupBy", mytest prop_TL_groupBy),
614+ testProperty "tl_groupBy" prop_TL_groupBy,
607− ("prop_T_inits", mytest prop_T_inits),
615+ testProperty "t_inits" prop_T_inits,
608− ("prop_TL_inits", mytest prop_TL_inits),
616+ testProperty "tl_inits" prop_TL_inits,
609− ("prop_T_tails", mytest prop_T_tails),
617+ testProperty "t_tails" prop_T_tails,
610− ("prop_TL_tails", mytest prop_TL_tails),
618+ testProperty "tl_tails" prop_TL_tails
611−
619+ ],
620+
621+ testGroup "breaking many" [
612− ("prop_T_split_i", mytest prop_T_split_i),
622+ testProperty "t_split_i" prop_T_split_i,
613− ("prop_T_splitTimes_i", mytest prop_T_splitTimes_i),
623+ testProperty "t_splitTimes_i" prop_T_splitTimes_i,
614− ("prop_T_splitTimes_split", mytest prop_T_splitTimes_split),
624+ testProperty "t_splitTimes_split" prop_T_splitTimes_split,
615− ("prop_T_splitTimesEnd_i", mytest prop_T_splitTimesEnd_i),
625+ testProperty "t_splitTimesEnd_i" prop_T_splitTimesEnd_i,
616− ("prop_T_splitTimesEnd_split", mytest prop_T_splitTimesEnd_split),
626+ testProperty "t_splitTimesEnd_split" prop_T_splitTimesEnd_split,
617− ("prop_TL_split_i", mytest prop_TL_split_i),
627+ testProperty "tl_split_i" prop_TL_split_i,
618− ("prop_T_splitWith", mytest prop_T_splitWith),
628+ testProperty "t_splitWith" prop_T_splitWith,
619− ("prop_T_splitWith_count", mytest prop_T_splitWith_count),
629+ testProperty "t_splitWith_count" prop_T_splitWith_count,
620− ("prop_T_splitWith_split", mytest prop_T_splitWith_split),
630+ testProperty "t_splitWith_split" prop_T_splitWith_split,
621− ("prop_T_splitWith_Csplit", mytest prop_T_splitWith_Csplit),
631+ testProperty "t_splitWith_Csplit" prop_T_splitWith_Csplit,
622− ("prop_TL_splitWith", mytest prop_TL_splitWith),
632+ testProperty "tl_splitWith" prop_TL_splitWith,
623− ("prop_T_chunksOf_same_lengths", mytest prop_T_chunksOf_same_lengths),
633+ testProperty "t_chunksOf_same_lengths" prop_T_chunksOf_same_lengths,
624− ("prop_T_chunksOf_length", mytest prop_T_chunksOf_length),
634+ testProperty "t_chunksOf_length" prop_T_chunksOf_length,
625− ("prop_T_breakSubstringC", mytest prop_T_breakSubstringC),
635+ testProperty "t_breakSubstringC" prop_T_breakSubstringC,
626− ("prop_T_breakSubstring_isInfixOf", mytest prop_T_breakSubstring_isInfixOf),
636+ testProperty "t_breakSubstring_isInfixOf" prop_T_breakSubstring_isInfixOf
627−
637+ ],
628− ("prop_T_lines", mytest prop_T_lines),
638+
639+ testGroup "lines and words" [
640+ testProperty "t_lines" prop_T_lines,
629− ("prop_TL_lines", mytest prop_TL_lines),
641+ testProperty "tl_lines" prop_TL_lines,
630−--("prop_T_lines'", mytest prop_T_lines'),
642+ --testProperty "t_lines'" prop_T_lines',
631− ("prop_T_words", mytest prop_T_words),
643+ testProperty "t_words" prop_T_words,
632− ("prop_TL_words", mytest prop_TL_words),
644+ testProperty "tl_words" prop_TL_words,
633− ("prop_T_unlines", mytest prop_T_unlines),
645+ testProperty "t_unlines" prop_T_unlines,
634− ("prop_TL_unlines", mytest prop_TL_unlines),
646+ testProperty "tl_unlines" prop_TL_unlines,
635− ("prop_T_unwords", mytest prop_T_unwords),
647+ testProperty "t_unwords" prop_T_unwords,
636− ("prop_TL_unwords", mytest prop_TL_unwords),
648+ testProperty "tl_unwords" prop_TL_unwords
637−
649+ ]
650+ ],
651+
652+ testGroup "predicates" [
638− ("prop_S_isPrefixOf", mytest prop_S_isPrefixOf),
653+ testProperty "s_isPrefixOf" prop_S_isPrefixOf,
639− ("prop_T_isPrefixOf", mytest prop_T_isPrefixOf),
654+ testProperty "t_isPrefixOf" prop_T_isPrefixOf,
640− ("prop_TL_isPrefixOf", mytest prop_TL_isPrefixOf),
655+ testProperty "tl_isPrefixOf" prop_TL_isPrefixOf,
641− ("prop_T_isSuffixOf", mytest prop_T_isSuffixOf),
656+ testProperty "t_isSuffixOf" prop_T_isSuffixOf,
642− ("prop_TL_isSuffixOf", mytest prop_TL_isSuffixOf),
657+ testProperty "tl_isSuffixOf" prop_TL_isSuffixOf,
643− ("prop_T_isInfixOf", mytest prop_T_isInfixOf),
658+ testProperty "t_isInfixOf" prop_T_isInfixOf,
644− ("prop_TL_isInfixOf", mytest prop_TL_isInfixOf),
659+ testProperty "tl_isInfixOf" prop_TL_isInfixOf
645−
660+ ],
646− ("prop_T_elem", mytest prop_T_elem),
661+
647− ("prop_TL_elem", mytest prop_TL_elem),
662+ testGroup "searching" [
663+ testProperty "t_elem" prop_T_elem,
664+ testProperty "tl_elem" prop_TL_elem,
648− ("prop_T_filter", mytest prop_T_filter),
665+ testProperty "t_filter" prop_T_filter,
649− ("prop_TL_filter", mytest prop_TL_filter),
666+ testProperty "tl_filter" prop_TL_filter,
650− ("prop_T_find", mytest prop_T_find),
667+ testProperty "t_find" prop_T_find,
651− ("prop_TL_find", mytest prop_TL_find),
668+ testProperty "tl_find" prop_TL_find,
652− ("prop_T_partition", mytest prop_T_partition),
669+ testProperty "t_partition" prop_T_partition,
653− ("prop_TL_partition", mytest prop_TL_partition),
670+ testProperty "tl_partition" prop_TL_partition
654−
671+ ],
655− ("prop_T_index", mytest prop_T_index),
672+
673+ testGroup "indexing" [
674+ testProperty "t_index" prop_T_index,
656− ("prop_TL_index", mytest prop_TL_index),
675+ testProperty "tl_index" prop_TL_index,
657− ("prop_T_findIndex", mytest prop_T_findIndex),
676+ testProperty "t_findIndex" prop_T_findIndex,
658− ("prop_TL_findIndex", mytest prop_TL_findIndex),
677+ testProperty "tl_findIndex" prop_TL_findIndex,
659− ("prop_T_findIndices", mytest prop_T_findIndices),
678+ testProperty "t_findIndices" prop_T_findIndices,
660− ("prop_TL_findIndices", mytest prop_TL_findIndices),
679+ testProperty "tl_findIndices" prop_TL_findIndices,
661− ("prop_T_elemIndex", mytest prop_T_elemIndex),
680+ testProperty "t_elemIndex" prop_T_elemIndex,
662− ("prop_TL_elemIndex", mytest prop_TL_elemIndex),
681+ testProperty "tl_elemIndex" prop_TL_elemIndex,
663− ("prop_T_elemIndices", mytest prop_T_elemIndices),
682+ testProperty "t_elemIndices" prop_T_elemIndices,
664− ("prop_TL_elemIndices", mytest prop_TL_elemIndices),
683+ testProperty "tl_elemIndices" prop_TL_elemIndices,
665− ("prop_T_count", mytest prop_T_count),
684+ testProperty "t_count" prop_T_count,
666− ("prop_TL_count", mytest prop_TL_count),
685+ testProperty "tl_count" prop_TL_count
667− ("prop_T_zip", mytest prop_T_zip),
686+ ],
668− ("prop_TL_zip", mytest prop_TL_zip),
687+
688+ testGroup "zips" [
689+ testProperty "t_zip" prop_T_zip,
690+ testProperty "tl_zip" prop_TL_zip,
669− ("prop_T_zipWith", mytest prop_T_zipWith),
691+ testProperty "t_zipWith" prop_T_zipWith,
670− ("prop_TL_zipWith", mytest prop_TL_zipWith),
692+ testProperty "tl_zipWith" prop_TL_zipWith
671−
693+ ],
694+
695+ testGroup "regressions" [
672− ("prop_S_filter_eq", mytest prop_S_filter_eq)
696+ testProperty "s_filter_eq" prop_S_filter_eq
673 ]
697 ]
698+ ]
tests/QuickCheckUtils.hs+8−68
@@ -2,19 +2,17 @@
2
2
3module QuickCheckUtils where
3module QuickCheckUtils where
4
4
5−import Data.List
5+import Data.Word (Word8, Word16)
6−import Data.Word
7import qualified Data.Text as T
6import qualified Data.Text as T
8import qualified Data.Text.Lazy as TL
7import qualified Data.Text.Lazy as TL
9−import System.IO
8+import System.Random (Random(..), RandomGen)
10−import System.Random
11−import Test.QuickCheck
9+import Test.QuickCheck (Arbitrary(..), choose, oneof, sized, variant, vector)
12import qualified Data.ByteString as B
10import qualified Data.ByteString as B
13
11
14integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
12integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
15integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
13integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
16 fromIntegral b :: Integer) g of
14 fromIntegral b :: Integer) g of
17− (x,g) -> (fromIntegral x, g)
15+ (x,h) -> (fromIntegral x, h)
18
16
19instance Random Word8 where
17instance Random Word8 where
20 randomR = integralRandomR
18 randomR = integralRandomR
@@ -25,12 +23,12 @@ instance Arbitrary Word8 where
25 coarbitrary c = variant (fromEnum c `rem` 4)
23 coarbitrary c = variant (fromEnum c `rem` 4)
26
24
27instance Arbitrary B.ByteString where
25instance Arbitrary B.ByteString where
28− arbitrary = B.pack `fmap` arbitrary
26+ arbitrary = B.pack `fmap` arbitrary
29− coarbitrary s = coarbitrary (B.unpack s)
27+ coarbitrary s = coarbitrary (B.unpack s)
30
28
31instance Random Word16 where
29instance Random Word16 where
32− randomR = integralRandomR
30+ randomR = integralRandomR
33− random = randomR (minBound,maxBound)
31+ random = randomR (minBound,maxBound)
34
32
35instance Arbitrary Word16 where
33instance Arbitrary Word16 where
36 arbitrary = choose (minBound,maxBound)
34 arbitrary = choose (minBound,maxBound)
@@ -69,61 +67,3 @@ instance Arbitrary (NotEmpty TL.Text) where
69instance Arbitrary (NotEmpty B.ByteString) where
67instance Arbitrary (NotEmpty B.ByteString) where
70 arbitrary = (fmap B.pack) `fmap` arbitrary
68 arbitrary = (fmap B.pack) `fmap` arbitrary
71 coarbitrary = coarbitrary . notEmpty
69 coarbitrary = coarbitrary . notEmpty
72−
73−debug = False
74−
75−mytest :: Testable a => a -> Int -> IO (Bool, Int)
76−mytest a n = mycheck defaultConfig
77− { configMaxTest=n
78− , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
79−
80−mycheck :: Testable a => Config -> a -> IO (Bool, Int)
81−mycheck config a =
82− do rnd <- newStdGen
83− mytests config (evaluate a) rnd 0 0 []
84−
85−mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO (Bool, Int)
86−mytests config gen rnd0 ntest nfail stamps
87− | ntest == configMaxTest config = done "OK," ntest stamps >> return (True, ntest)
88− | nfail == configMaxFail config = done "Arguments exhausted after" ntest stamps >> return (True, ntest)
89− | otherwise =
90− do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
91− case ok result of
92− Nothing ->
93− mytests config gen rnd1 ntest (nfail+1) stamps
94− Just True ->
95− mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
96− Just False ->
97− putStr ( "Falsifiable after "
98− ++ show ntest
99− ++ " tests:\n"
100− ++ unlines (arguments result)
101− ) >> hFlush stdout >> return (False, ntest)
102− where
103− result = generate (configSize config ntest) rnd2 gen
104− (rnd1,rnd2) = split rnd0
105−
106−done :: String -> Int -> [[String]] -> IO ()
107−done mesg ntest stamps =
108− do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
109− where
110− table = display
111− . map entry
112− . reverse
113− . sort
114− . map pairLength
115− . group
116− . sort
117− . filter (not . null)
118− $ stamps
119−
120− display [] = ".\n"
121− display [x] = " (" ++ x ++ ").\n"
122− display xs = ".\n" ++ unlines (map (++ ".") xs)
123−
124− pairLength xss@(xs:_) = (length xss, xs)
125− entry (n, xs) = percentage n ntest
126− ++ " "
127− ++ concat (intersperse ", " xs)
128−
129− percentage n m = show ((100 * n) `div` m) ++ "%"