git.iko.soy/text
on master help sign in
Add the test code

--HG-- extra : convert_revision : dd952468476847a89bca873875b2b3a298c5a2b1

commit404e119cd15854abf4fe8d601411864bf17cb66b authorDuncan Coutts <duncan@haskell.org> dateSun 18 Jan 2009, 16:21 (18 years ago) parentfd96b66
6 files changed+502
compare with master
unifiedsplit
tests/Bench.hs+186 tests/BenchUtils.hs+80 tests/EncodingBench.hs+106 tests/FusionBench.hs+51 tests/Properties.hs+62 tests/QuickCheckUtils.hs+17
tests/Bench.hsnew file+186
@@ -0,0 +1,186 @@
1+{-# OPTIONS_GHC -fglasgow-exts -fbang-patterns #-}
2+
3+--module Bench where
4+
5+import BenchUtils
6+import System.Mem
7+import Control.Concurrent
8+import Char
9+import Data.Array.IArray
10+import System.CPUTime
11+import System.IO
12+import System.IO.Unsafe
13+import Text.Printf
14+import Control.Exception
15+
16+import qualified Text as T
17+import Text.Internal
18+import qualified Text.Fusion as S
19+import Text.Fusion (Encoding(..))
20+
21+import qualified Data.List as L
22+import qualified Data.ByteString as B
23+import Data.ByteString (ByteString)
24+import Data.Word
25+import qualified System.IO.UTF8 as UTF8
26+
27+main = do ascii_bs <- B.readFile "ascii.txt"
28+ let ascii_txt = T.decode ASCII ascii_bs
29+ let ascii_str = T.unpack ascii_txt
30+ force (ascii_txt,ascii_str,ascii_bs)
31+ printf " # Text\t\tString\tByteString\n"
32+ run 1 (ascii_txt,ascii_str,ascii_bs) ascii_tests
33+ performGC
34+ bmp_txt <- T.readFile Utf8 "bmp.txt"
35+ let bmp_str = T.unpack bmp_txt
36+ force (bmp_txt,bmp_str)
37+ printf " # Text\t\tString\t\n"
38+ run 1 (bmp_txt, bmp_str, B.empty) bmp_tests
39+ performGC
40+ smp_sip_txt <- T.readFile Utf8 "smp_sip.txt"
41+ let smp_sip_str = T.unpack smp_sip_txt
42+ force (smp_sip_txt, smp_sip_str)
43+ printf " # Text\t\tString\t\n"
44+ run 1 (smp_sip_txt, smp_sip_str,B.empty) smp_sip_tests
45+
46+
47+ascii_tests = [
48+ ("cons",
49+ [F (app1 (T.cons '\88')),
50+ F (app2 ((:) '\88') ),
51+ F (app3 (B.cons 88) )]),
52+ ("head",
53+ [F (app1 T.head),
54+ F (app2 L.head),
55+ F (app3 B.head)]),
56+ ("last",
57+ [F (app1 T.last),
58+ F (app2 L.last),
59+ F (app3 B.last)]),
60+ ("tail",
61+ [F (app1 T.tail),
62+ F (app2 L.tail),
63+ F (app3 B.tail)]),
64+ ("init",
65+ [F (app1 T.init),
66+ Flist (app2 L.init),
67+ F (app3 B.init) ]),
68+ ("null",
69+ [F (app1 T.null),
70+ F (app2 L.null),
71+ F (app3 B.null) ]),
72+ ("length",
73+ [F (app1 T.length),
74+ F (app2 L.length),
75+ F (app3 B.length)]),
76+ ("map",
77+ [F (app1 $ T.map succ),
78+ Flist (app2 (L.map succ)),
79+ F (app3 $ B.map succ)]),
80+ ("filter",
81+ [F $ app1 $ T.filter (/= '\101'),
82+ Flist $ app2 $ L.filter (/= '\101'),
83+ F $ app3 $ B.filter (/= 101)]),
84+ ("foldl'",
85+ [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
86+ F (app2 $ L.foldl' (\a w -> a+1::Int) 0),
87+ F (app3 $ B.foldl' (\a w -> a+1::Int) 0)
88+ ]),
89+ ("drop",
90+ [F (app1 $ T.drop 30000000),
91+ Flist (app2 $ L.drop 30000000),
92+ F (app3 $ B.drop 30000000)
93+ ]),
94+ ("take",
95+ [F (app1 $ T.take 30000000),
96+ Flist (app2 $ L.take 30000000),
97+ F (app3 $ B.take 30000000)]),
98+ ("words",
99+ [F (app1 $ T.words),
100+ Flist (app2 $ L.words)])
101+ ]
102+
103+bmp_tests = [
104+ ("cons",
105+ [F (app1 (T.cons '\88')),
106+ F (app2 ((:) '\88') )]),
107+ ("head",
108+ [F (app1 T.head),
109+ F (app2 L.head)]),
110+ ("last",
111+ [F (app1 T.last),
112+ F (app2 L.last)]),
113+ ("tail",
114+ [F (app1 T.tail),
115+ F (app2 L.tail)]),
116+ ("init",
117+ [F (app1 T.init),
118+ Flist (app2 L.init)]),
119+ ("null",
120+ [F (app1 T.null),
121+ F (app2 L.null),
122+ F (app3 B.null)]),
123+ ("length",
124+ [F (app1 T.length),
125+ F (app2 L.length),
126+ F (app3 B.length)]),
127+ ("map",
128+ [F (app1 $ T.map succ),
129+ Flist (app2 (L.map succ))]),
130+ ("filter",
131+ [F $ app1 $ T.filter (/= '\101'),
132+ Flist $ app2 $ L.filter (/= '\101')]),
133+ ("foldl'",
134+ [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
135+ F (app2 $ L.foldl' (\a w -> a+1::Int) 0)]),
136+ ("drop",
137+ [F (app1 $ T.drop 30000000),
138+ Flist (app2 $ L.drop 30000000)]),
139+ ("take",
140+ [F (app1 $ T.take 30000000),
141+ Flist (app2 $ L.take 30000000)]),
142+ ("words",
143+ [F (app1 $ T.words),
144+ Flist (app2 $ L.words)])
145+ ]
146+
147+smp_sip_tests = [
148+ ("cons",
149+ [F (app1 (T.cons '\65624')),
150+ F (app2 ((:) '\65624'))]),
151+ ("head",
152+ [F (app1 T.head),
153+ F (app2 L.head)]),
154+ ("last",
155+ [F (app1 T.last),
156+ F (app2 L.last)]),
157+ ("tail",
158+ [F (app1 T.tail),
159+ F (app2 L.tail)]),
160+ ("init",
161+ [F (app1 T.init),
162+ Flist (app2 L.init)]),
163+ ("null",
164+ [F (app1 T.null),
165+ F (app2 L.null),
166+ F (app3 B.null) ]),
167+ ("length",
168+ [F (app1 T.length ),
169+ F (app2 L.length),
170+ F (app3 B.length)]),
171+ ("map",
172+ [F (app1 $ T.map succ),
173+ Flist (app2 (L.map succ))]),
174+ ("filter",
175+ [F $ app1 $ T.filter (/= '\65624'),
176+ Flist $ app2 $ L.filter (/= '\65624')]),
177+ ("foldl'",
178+ [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
179+ F (app2 $ L.foldl' (\a w -> a+1::Int) 0)]),
180+ ("drop",
181+ [F (app1 $ T.drop 30000000),
182+ Flist (app2 $ L.drop 30000000)]),
183+ ("take",
184+ [F (app1 $ T.take 30000000),
185+ Flist (app2 $ L.take 30000000)])
186+ ]
tests/BenchUtils.hsnew file+80
@@ -0,0 +1,80 @@
1+{-# OPTIONS_GHC -fglasgow-exts -fbang-patterns #-}
2+
3+module BenchUtils where
4+
5+import qualified Data.List as L
6+import Data.ByteString (ByteString(..))
7+import Data.Word
8+import Text.Printf
9+import System.IO
10+import Text.Internal (Text(..))
11+import System.Mem
12+import System.CPUTime
13+import Control.Exception
14+import Control.Concurrent
15+
16+data Result = T | B
17+
18+data F a = forall b. F (a -> b) | forall b. Flist (a -> [b])
19+
20+class Forceable a where
21+ force :: a -> IO Result
22+ force v = v `seq` return T
23+
24+instance Forceable Text
25+
26+seqList = L.foldl' (flip seq) (return ())
27+instance Forceable [a] where
28+ force = L.foldl' (flip seq) (return T)
29+
30+instance Forceable ByteString
31+instance Forceable Char
32+instance Forceable Bool
33+instance Forceable Int
34+instance Forceable Word8
35+
36+instance (Forceable a, Forceable b) => Forceable (a,b) where
37+ force (a,b) = force a >> force b
38+
39+instance (Forceable a, Forceable b, Forceable c) => Forceable (a,b,c) where
40+ force (a,b,c) = force a >> force b >> force c
41+
42+run c x tests = sequence_ $ zipWith (runTest c x) [1..] tests
43+
44+runTest :: Int -> a -> Int -> (String,[F a]) -> IO ()
45+runTest count x n (name,tests) = do
46+ printf "%2d " n
47+ fn tests
48+ printf "\t# %-16s\n" (show name)
49+ hFlush stdout
50+ where fn xs = case xs of
51+ [f,g,h] -> runN count f x >> putStr "\t"
52+ >> runN count g x >> putStr "\t"
53+ >> runN count h x >> putStr "\t"
54+ [f,g] -> runN count f x >> putStr "\t"
55+ >> runN count g x >> putStr "\t\t"
56+ [f] -> runN count f x >> putStr "\t\t\t"
57+ _ -> return ()
58+ run f x = performGC >> threadDelay 100 >> time f x
59+ runN 0 f x = return ()
60+ runN c f x = run f x >> runN (c-1) f x
61+
62+time (Flist f) a = do
63+ start <- getCPUTime
64+ v <- seqList (f a)
65+ end <- getCPUTime
66+ let diff = (fromIntegral (end - start)) / 10^12
67+ printf "%0.3f" (diff :: Double)
68+ hFlush stdout
69+
70+time (F f) a = do
71+ start <- getCPUTime
72+ v <- evaluate (f a)
73+ end <- getCPUTime
74+ let diff = (fromIntegral (end - start)) / 10^12
75+ printf "%0.3f" (diff :: Double)
76+ hFlush stdout
77+
78+app1 f (x,y,z) = f x
79+app2 f (x,y,z) = f y
80+app3 f (x,y,z) = f z
tests/EncodingBench.hsnew file+106
@@ -0,0 +1,106 @@
1+{-# OPTIONS_GHC -fglasgow-exts #-}
2+
3+import BenchUtils
4+import qualified Data.Text.Utf8.Fusion as U8
5+import qualified Data.Text.Utf8.Internal as U8I
6+import qualified Data.Text.Utf32.Fusion as U32
7+import qualified Data.Text.Utf32.Internal as U32I
8+import qualified Data.Text.Fusion as S
9+import Data.Text.Fusion (bsStream,Encoding(..))
10+import qualified Data.Text as T
11+import qualified Data.ByteString as B
12+import Text.Printf
13+import System.Mem
14+
15+instance Forceable U32I.Text
16+instance Forceable U8I.Text
17+
18+data E a = forall b. E (a -> b) | EText (a -> S.Stream Char)
19+
20+main = do force (ascii_tests, smp_sip_tests)
21+ ascii <- B.readFile "ascii.txt"
22+ let ascii8 = U8.unstream (bsStream ascii ASCII)
23+ let ascii16 = S.unstream (bsStream ascii ASCII)
24+ let ascii32 = U32.unstream (bsStream ascii ASCII)
25+ force (ascii8, ascii16, ascii32)
26+ printf " # Utf8\t\tUtf16\tUtf32\n"
27+ run 1 (ascii8, ascii16, ascii32) ascii_tests
28+ performGC
29+ bmp <- B.readFile "bmp.txt"
30+ let bmp8 = U8.unstream (bsStream bmp Utf8)
31+ let bmp16 = S.unstream (bsStream bmp Utf8)
32+ let bmp32 = U32.unstream (bsStream bmp Utf8)
33+ force (bmp8, bmp16, bmp32)
34+ printf " # Utf8\t\tUtf16\tUtf32\n"
35+ run 1 (bmp8, bmp16, bmp32) ascii_tests
36+ performGC
37+ smp_sip <- B.readFile "smp_sip.txt"
38+ let smp_sip8 = U8.unstream (bsStream smp_sip Utf8)
39+ let smp_sip16 = S.unstream (bsStream smp_sip Utf8)
40+ let smp_sip32 = U32.unstream (bsStream smp_sip Utf8)
41+ force (smp_sip8, smp_sip16, smp_sip32)
42+ printf " # Utf8\t\tUtf16\tUtf32\n"
43+ run 1 (smp_sip8, smp_sip16, smp_sip32) smp_sip_tests
44+
45+ascii_tests = [
46+ ("cons" ,
47+ [F $ app1 $ U8.unstream . S.cons '\88' . U8.stream,
48+ F $ app2 $ S.unstream . S.cons '\88' . S.stream,
49+ F $ app3 $ U32.unstream . S.cons '\88' . U32.stream]),
50+ ("length",
51+ [F $ app1 $ S.length . U8.stream,
52+ F $ app2 $ S.length . S.stream,
53+ F $ app3 $ S.length . U32.stream]),
54+ ("map" ,
55+ [F $ app1 $ U8.unstream . S.map succ . U8.stream,
56+ F $ app2 $ S.unstream . S.map succ . S.stream,
57+ F $ app3 $ U32.unstream . S.map succ . U32.stream]),
58+ ("filter",
59+ [F $ app1 $ U8.unstream . S.filter (/= '\101') . U8.stream,
60+ F $ app2 $ S.unstream . S.filter (/= '\101') . S.stream,
61+ F $ app3 $ U32.unstream . S.filter (/= '\101') . U32.stream]),
62+ ("take",
63+ [F $ app1 $ U8.unstream . S.take 1000000 . U8.stream,
64+ F $ app2 $ S.unstream . S.take 1000000 . S.stream,
65+ F $ app3 $ U32.unstream . S.take 1000000 . U32.stream]),
66+ ("drop" ,
67+ [F $ app1 $ U8.unstream . S.drop 1000000 . U8.stream,
68+ F $ app2 $ S.unstream . S.drop 1000000 . S.stream,
69+ F $ app3 $ U32.unstream . S.drop 1000000 . U32.stream]),
70+ ("foldl'",
71+ [F $ app1 $ S.foldl' (\a w -> a+1::Int) 0 . U8.stream,
72+ F $ app2 $ S.foldl' (\a w -> a+1::Int) 0 . S.stream,
73+ F $ app3 $ S.foldl' (\a w -> a+1::Int) 0 . U32.stream
74+ ])
75+ ]
76+
77+smp_sip_tests = [
78+ ("cons" ,
79+ [F $ app1 $ U8.unstream . S.cons '\88' . U8.stream,
80+ F $ app2 $ S.unstream . S.cons '\88' . S.stream,
81+ F $ app3 $ U32.unstream . S.cons '\88' . U32.stream]),
82+ ("length",
83+ [F $ app1 $ S.length . U8.stream,
84+ F $ app2 $ S.length . S.stream,
85+ F $ app3 $ S.length . U32.stream]),
86+ ("map" ,
87+ [F $ app1 $ U8.unstream . S.map succ . U8.stream,
88+ F $ app2 $ S.unstream . S.map succ . S.stream,
89+ F $ app3 $ U32.unstream . S.map succ . U32.stream]),
90+ ("filter",
91+ [F $ app1 $ U8.unstream . S.filter (/= '\101') . U8.stream,
92+ F $ app2 $ S.unstream . S.filter (/= '\101') . S.stream,
93+ F $ app3 $ U32.unstream . S.filter (/= '\101') . U32.stream]),
94+ ("take",
95+ [F $ app1 $ U8.unstream . S.take 1000000 . U8.stream,
96+ F $ app2 $ S.unstream . S.take 1000000 . S.stream,
97+ F $ app3 $ U32.unstream . S.take 1000000 . U32.stream]),
98+ ("drop" ,
99+ [F $ app1 $ U8.unstream . S.drop 1000000 . U8.stream,
100+ F $ app2 $ S.unstream . S.drop 1000000 . S.stream,
101+ F $ app3 $ U32.unstream . S.drop 1000000 . U32.stream]),
102+ ("foldl'",
103+ [F $ app1 $ S.foldl' (\a w -> a+1::Int) 0 . U8.stream,
104+ F $ app2 $ S.foldl' (\a w -> a+1::Int) 0 . S.stream,
105+ F $ app3 $ S.foldl' (\a w -> a+1::Int) 0 . U32.stream])
106+ ]
tests/FusionBench.hsnew file+51
@@ -0,0 +1,51 @@
1+import Prelude hiding (zip,zip3,fst,snd)
2+
3+import BenchUtils
4+import Char
5+import qualified Data.List as L
6+import qualified Data.ByteString as B
7+import qualified Text as T
8+import Text.Fusion (Encoding(..))
9+import qualified Text.Fusion as S
10+import Text.Printf
11+import System.IO
12+import System.Mem
13+import qualified System.IO.UTF8 as UTF8
14+
15+main = do ascii_str <- readFile "ascii.txt"
16+ ascii_bs <- B.readFile "ascii.txt"
17+ let ascii_txt = T.decode ASCII ascii_bs
18+ force (ascii_txt,ascii_str,ascii_bs)
19+ printf " # Text\t\tString\tByteString\n"
20+ run 1 (ascii_txt,ascii_str,ascii_bs) ascii_tests
21+
22+ascii_tests = [
23+ ("map/map",
24+ [F $ T.map pred . T.map succ . fst,
25+ Flist $ L.map pred . L.map succ . snd,
26+ F $ B.map pred . B.map succ . trd]),
27+ ("filter/filter",
28+ [F $ T.filter (/= '\101') . T.filter (/= '\102') . fst,
29+ Flist $ L.filter (/= '\101') . L.filter (/= '\102') . snd,
30+ F $ B.filter (/= 101) . B.filter (/= 102) . trd]),
31+ ("filter/map",
32+ [F $ T.filter (/= '\103') . T.map succ . fst,
33+ Flist $ L.filter (/= '\103') . L.map succ . snd,
34+ F $ B.filter (/= 103) . B.map succ . trd]),
35+ ("map/filter",
36+ [F $ T.map succ . T.filter (/= '\104') . fst,
37+ Flist $ L.map succ . L.filter (/= '\104') . snd,
38+ F $ B.map succ . B.filter (/= 104) . trd]),
39+ ("foldl'/map",
40+ [F $ T.foldl' (const . (+1)) (0 :: Int) . T.map succ . fst,
41+ F $ L.foldl' (const . (+1)) (0 :: Int) . L.map succ . snd,
42+ F $ B.foldl' (const . (+1)) (0 :: Int) . B.map succ . trd]),
43+ ("foldl'/filter",
44+ [F $ T.foldl' (const . (+2)) (0::Int) . T.filter (/= '\105') . fst,
45+ F $ L.foldl' (const . (+2)) (0::Int) . L.filter (/= '\105') . snd,
46+ F $ B.foldl' (const . (+2)) (0::Int) . B.filter (/= 105) . trd]),
47+ ("foldl'/map/filter",
48+ [F $ T.foldl' (const.(+3)) (0::Int) . T.map succ . T.filter (/='\110') . fst,
49+ F $ L.foldl' (const.(+3)) (0::Int) . L.map succ . L.filter (/='\110') . snd,
50+ F $ B.foldl' (const . (+3)) (0::Int) . B.map succ . B.filter (/= 110) . trd])
51+ ]
tests/Properties.hsnew file+62
@@ -0,0 +1,62 @@
1+{-# OPTIONS_GHC -fno-rewrite-rules #-}
2+
3+import Test.QuickCheck
4+import Text.Show.Functions
5+
6+import Prelude
7+import qualified Text as T
8+import Text (pack,unpack)
9+import qualified Text.Fusion as S
10+import Text.Fusion (unstream,stream)
11+import qualified Data.List as L
12+
13+
14+import QuickCheckUtils
15+
16+prop_pack_unpack s = (unpack . pack) s == s
17+prop_stream_unstream t = (unstream . stream) t == t
18+prop_singleton c = [c] == (unpack . T.singleton) c
19+
20+prop_cons x xs = (x:xs) == (unpack . T.cons x . pack) xs
21+prop_snoc x xs = (xs ++ [x]) == (unpack . (flip T.snoc) x . pack) xs
22+prop_append s1 s2 = (s1 ++ s2) == (unpack $ T.append (pack s1) (pack s2))
23+prop_appendS s1 s2 = (s1 ++ s2) == ((unpack . unstream) $ S.append ((stream . pack) s1) ((stream . pack) s2))
24+prop_head s = not (null s) ==> head s == (T.head . pack) s
25+prop_last s = not (null s) ==> last s == (T.last . pack) s
26+prop_lastS s = not (null s) ==> last s == (S.last . stream . pack) s
27+prop_tail s = not (null s) ==> tail s == (unpack . T.tail . pack) s
28+prop_tailS s = not (null s) ==> tail s == (unpack . unstream . S.tail . stream . pack) s
29+prop_init s = not (null s) ==> init s == (unpack . T.init . pack) s
30+prop_initS s = not (null s) ==> init s == (unpack . unstream . S.init . stream . pack) s
31+prop_null s = null s == (T.null . pack) s
32+prop_length s = length s == (T.length . pack) s
33+prop_map f s = (map f s) == (unpack . T.map f . pack) s
34+prop_intersperse c s = (L.intersperse c s) == (unpack . T.intersperse c . pack) s
35+prop_transpose ss = (L.transpose ss) == (map unpack . T.transpose . map pack) ss
36+
37+prop_foldl f z s = L.foldl f z s == T.foldl f z (pack s)
38+prop_foldl' f z s = L.foldl' f z s == T.foldl' f z (pack s)
39+prop_foldl1 f s = not (null s) ==> L.foldl1 f s == T.foldl1 f (pack s)
40+prop_foldl1' f s = not (null s) ==> L.foldl1' f s == T.foldl1' f (pack s)
41+prop_foldr f z s = L.foldr f z s == T.foldr f z (pack s)
42+prop_foldr1 f s = not (null s) ==> L.foldr1 f s == T.foldr1 f (pack s)
43+
44+prop_concat ss = (L.concat ss) == (unpack . T.concat . map pack) ss
45+prop_concatMap f s = (L.concatMap f s) == (unpack (T.concatMap (pack . f) (pack s)))
46+prop_any p s = L.any p s == T.any p (pack s)
47+prop_all p s = L.all p s == T.all p (pack s)
48+prop_minimum s = not (null s) ==> L.minimum s == T.minimum (pack s)
49+prop_maximum s = not (null s) ==> L.maximum s == T.maximum (pack s)
50+
51+prop_take n s = L.take n s == (unpack . T.take n . pack) s
52+prop_drop n s = L.drop n s == (unpack . T.drop n . pack) s
53+prop_takeWhile p s = L.takeWhile p s == (unpack . T.takeWhile p . pack) s
54+prop_dropWhile p s = L.dropWhile p s == (unpack . T.dropWhile p . pack) s
55+prop_elem c s = L.elem c s == (T.elem c . pack) s
56+prop_find p s = L.find p s == (T.find p . pack) s
57+prop_filter p s = L.filter p s == (unpack . T.filter p . pack) s
58+prop_index x s = x < L.length s && x >= 0 ==> (L.!!) s x == T.index (pack s) x
59+prop_findIndex p s = L.findIndex p s == T.findIndex p (pack s)
60+prop_elemIndex c s = L.elemIndex c s == T.elemIndex c (pack s)
61+prop_zipWith c s1 s2 = L.zipWith c s1 s2 == unpack (T.zipWith c (pack s1) (pack s2))
62+prop_words s = L.words s == L.map unpack (T.words (pack s))
tests/QuickCheckUtils.hsnew file+17
@@ -0,0 +1,17 @@
1+module QuickCheckUtils where
2+
3+import Test.QuickCheck
4+import Test.QuickCheck.Batch
5+
6+import Char
7+
8+import Text
9+import Text.Internal
10+
11+instance Arbitrary Char where
12+ arbitrary = oneof [choose ('\0','\55295'), choose ('\57334','\1114111')]
13+ coarbitrary c = variant (ord c `rem` 4)
14+
15+instance Arbitrary Text where
16+ arbitrary = pack `fmap` arbitrary
17+ coarbitrary s = coarbitrary (unpack s)