git.iko.soy/text
on master help sign in
Merge 420d46b4289a8802c82e75828e701e7111d35a7b into f23938f81ec4b912f5f7822fef01a4a6b0133fcf
47dd97bGitHub Merge Button
tests/Chartem.hsdeleted−153
compare with master
unifiedsplit
@@ -1,153 +0,0 @@
1−{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
2−
3−import Data.Char
4−import Control.Monad (forM_)
5−import Data.Accessor ((^=))
6−import Data.Function
7−import Data.Maybe
8−import Data.List
9−import Debug.Trace
10−import Data.Text (Text)
11−import Data.Text.Encoding (decodeUtf8)
12−import Graphics.Rendering.Chart
13−import Graphics.Rendering.Chart.Gtk (renderableToWindow)
14−import System.Environment (getArgs)
15−import Text.Printf
16−import qualified Data.ByteString as B
17−import qualified Data.Map as M
18−import qualified Data.Text as T
19−
20−data Row = Row {
21− rowName :: !Text
22− , rowMean :: !Double
23− , rowMeanLB :: !Double
24− , rowMeanUB :: !Double
25− , rowStdDev :: !Double
26− , rowStdDevLB :: !Double
27− , rowStdDevUB :: !Double
28− } deriving (Show)
29−
30−parseRow :: Text -> Row
31−parseRow = f . T.split ","
32− where f [n,m,ml,mu,s,sl,su] = Row {
33− rowName = n
34− , rowMean = r m
35− , rowMeanLB = r ml
36− , rowMeanUB = r mu
37− , rowStdDev = r s
38− , rowStdDevLB = r sl
39− , rowStdDevUB = r su
40− }
41− r = read . T.unpack
42−
43−readCSV :: FilePath -> IO [Row]
44−readCSV = fmap (map parseRow . tail . T.lines . decodeUtf8) . B.readFile
45−
46−groupRows :: [Row] -> M.Map Text [Row]
47−groupRows = M.map (sortBy (compare `on` rowName)) . foldr f M.empty
48− where f r m = let (p,s) = T.breakEnd "/" (rowName r)
49− in M.insertWith' (++) (T.init . T.tail $ p)
50− [r { rowName = T.init s}] m
51−
52−main = do
53− args <- getArgs
54− groups <- mapM (fmap groupRows . readCSV) args
55− let dd = M.unionsWith (++) . map (M.map (:[])) $ groups
56− forM_ (M.toList dd) $ \(tdesc,rows) -> do
57− let desc = T.unpack tdesc
58− if False
59− then renderableToWindow (renderMark desc rows) 400 160
60− else renderableToPNGFile (renderMark desc rows) 400 160
61− (printf "time-%s.png" (map clean desc))
62− where clean '/' = '-'
63− clean c | isSpace c = '-'
64− | otherwise = c
65−
66−instance BarsPlotValue LogValue where
67− barsReference = LogValue 1e-300
68− barsAdd (LogValue a) (LogValue b) = LogValue (a * b)
69−
70−renderMark :: String -> [[Row]] -> Renderable ()
71−renderMark desc rows
72− | useLog = toRenderable linLayout
73− | otherwise = toRenderable logLayout
74− where
75− useLog = minimum (map minimum values) >= maximum (map maximum values) / 25
76− values = transpose . map (map rowMean) $ rows
77− keys = map git (head rows)
78− where git r = let n = T.unpack . rowName $ r
79− in maybe n id . flip lookup mappings $ n
80− mappings = [("bl", "lazy BS"), ("bs", "strict BS"), ("l", "list"),
81− ("tl", "lazy T"), ("ts", "strict T")]
82−
83− linLayout = layout1_title ^= "Timings for \"" ++ desc ++ "\""
84− $ layout1_plots ^= [ Left (plotBars linBars) ]
85− $ layout1_left_axis ^= linLeftAxis
86− $ layout1_bottom_axis ^= bottomAxis
87− $ defaultLayout1 :: Layout1 Double Double
88−
89− logLayout = layout1_title ^= "Timings for \"" ++ desc ++
90− "\" (log scale)"
91− $ layout1_plots ^= [ Left (plotBars logBars) ]
92− $ layout1_left_axis ^= logLeftAxis
93− $ layout1_bottom_axis ^= bottomAxis
94− $ defaultLayout1 :: Layout1 Double LogValue
95−
96− logLeftAxis = laxis_generate ^= autoScaledLogAxis logSecAxis
97− $ laxis_reverse ^= False
98− $ defaultLayoutAxis
99−
100− linLeftAxis = laxis_generate ^= autoScaledAxis linSecAxis
101− $ defaultLayoutAxis
102−
103− bottomAxis = laxis_generate ^= autoScaledAxis typeAxis
104− $ defaultLayoutAxis
105−
106− linBars = plot_bars_values ^= (zip [0.5,1.5..] values)
107− $ defaultPlotBars
108−
109− logBars = plot_bars_values ^= (zip [0.5,1.5..] . map (map LogValue) $ values)
110− $ defaultPlotBars
111−
112− typeAxis = la_labelf ^= (ix keys . floor)
113− $ la_nLabels ^= length keys
114− $ defaultLinearAxis
115−
116− ix (x:xs) n | n <= 0 = x
117− | otherwise = ix xs (n-1)
118− ix [] _ = ""
119−
120− linSecAxis = la_labelf ^= secs
121− $ defaultLinearAxis
122−
123− logSecAxis = loga_labelf ^= (secs . fromLV)
124− $ defaultLogAxis
125−
126− fromLV (LogValue v) = v
127−
128−-- | Try to render meaningful time-axis labels.
129−--
130−-- /FIXME/: Trouble is, we need to know the range of times for this to
131−-- work properly, so that we don't accidentally display consecutive
132−-- values that appear identical (e.g. \"43 ms, 43 ms\").
133−secs :: Double -> String
134−secs k
135− | k < 0 = '-' : secs (-k)
136− | k >= 1e9 = (k/1e9) `with` "Gs"
137− | k >= 1e6 = (k/1e6) `with` "Ms"
138− | k >= 1e4 = (k/1e3) `with` "Ks"
139− | k >= 1 = k `with` "s"
140− | k >= 1e-3 = (k*1e3) `with` "ms"
141− | k >= 1e-6 = (k*1e6) `with` "µs"
142− | k >= 1e-9 = (k*1e9) `with` "ns"
143− | k >= 1e-12 = (k*1e12) `with` "ps"
144− | otherwise = printf "%g s" k
145− where with (t :: Double) (u :: String)
146− | t >= 1e9 = printf "%.4g %s" t u
147− | t >= 1e6 = printf "%.0f %s" t u
148− | t >= 1e5 = printf "%.0f %s" t u
149− | t >= 1e4 = printf "%.0f %s" t u
150− | t >= 1e3 = printf "%.0f %s" t u
151− | t >= 1e2 = printf "%.0f %s" t u
152− | t >= 1e1 = printf "%.0f %s" t u
153− | otherwise = printf "%.0f %s" t u
tests/Makefiledeleted−96
@@ -1,96 +0,0 @@
1−version := $(shell awk '/^version:/{print $$2}' ../text.cabal)
2−ghc-major-version := $(shell ghc --numeric-version | sed 's/\..*//')
3−ghc := ghc
4−ghc-opt-flags = -O0
5−ghc-base-flags := -funbox-strict-fields -hide-all-packages \
6− -package base -package mtl -package random -package directory \
7− -package criterion -package deepseq -DASSERTS -DHAVE_DEEPSEQ \
8− -package bytestring -ignore-package text \
9− -fno-ignore-asserts
10−ifeq ($(ghc-major-version),7)
11− ghc-base-flags += -rtsopts
12−endif
13−ghc-test-flags := -package QuickCheck -package test-framework -package deepseq \
14− -package test-framework-quickcheck2 -package test-framework-hunit \
15− -package HUnit -package directory
16−ghc-base-flags += -Wall -fno-warn-orphans -fno-warn-missing-signatures
17−ghc-flags := $(ghc-base-flags) -i../dist/build -package-name text-$(version)
18−ghc-hpc-flags := $(ghc-base-flags) -fhpc -fno-ignore-asserts -odir hpcdir \
19− -hidir hpcdir -i..
20−lib := ../dist/build/libHStext-$(version).a
21−lib-srcs := $(shell grep '^ *Data' ../text.cabal | \
22− sed -e 's,\.,/,g' -e 's,$$,.hs,')
23−
24−cabal := $(shell which cabal 2>/dev/null)
25−
26−all: qc coverage regressions
27−
28−lib: $(lib)
29−
30−$(lib): $(lib-srcs:%=../%)
31−ifeq ($(cabal),)
32− cd .. && runghc Setup configure --user --prefix=$(HOME)
33− cd .. && runghc Setup build
34−else
35− cd .. && cabal configure
36− cd .. && cabal build
37−endif
38−
39−Properties.o Regressions.o qc qc-hpc: ghc-flags += $(ghc-test-flags)
40−Properties.o: QuickCheckUtils.o SlowFunctions.o TestUtils.o
41−
42−QuickCheckUtils.o: $(lib)
43−
44−qc: Properties.o QuickCheckUtils.o SlowFunctions.o TestUtils.o
45− $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)
46−
47−sb: SearchBench.o SlowFunctions.o
48− $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)
49−
50−qc-hpc: Properties.hs QuickCheckUtils.hs SlowFunctions.hs TestUtils.hs $(lib-srcs:%=../%)
51− -mkdir -p hpcdir
52− @rm -f $@.tix
53− $(ghc) $(ghc-hpc-flags) $(ghc-test-flags) $(ghc-opt-flags) -ihpcdir \
54− --make -threaded -o $@ $<
55−
56−stdio-hpc: StdioCoverage.hs $(lib-srcs:%=../%)
57− -mkdir -p hpcdir
58− @rm -f $@.tix
59− $(ghc) $(ghc-hpc-flags) $(ghc-test-flags) $(ghc-opt-flags) -ihpcdir \
60− --make -threaded -o $@ $<
61−
62−coverage: coverage-html/hpc_index.html
63−
64−coverage-html/hpc_index.html: qc-hpc stdio-hpc
65− @rm -f qc-hpc.tix stdio-hpc.tix coverage.tix
66− ./qc-hpc -a 100 +RTS -N
67− bash ./cover-stdio.sh
68− hpc combine --output=coverage.tix --exclude=Main \
69− qc-hpc.tix stdio-hpc.tix
70− hpc markup coverage --exclude=Main --exclude=Properties --exclude=Main \
71− --exclude=Data.Text.Fusion.CaseMapping --exclude StdioCoverage \
72− --exclude=SlowFunctions --exclude=TestUtils \
73− --exclude=QuickCheckUtils --srcdir=.. --srcdir=. --destdir=$(dir $@)
74− @echo xdg-open $@
75−
76−Regressions.o: TestUtils.o
77−
78−regressions: Regressions.o TestUtils.o
79− $(ghc) $(ghc-test-flags) -o $@ $^ $(lib)
80−
81−SlowFunctions.o: ghc-opt-flags = -O2
82−SearchBench.o: ghc-opt-flags = -O
83−%.o: %.hs
84− $(ghc) $(ghc-flags) $(ghc-opt-flags) -c -o $@ $<
85−
86−hpcdir/%.o: %.hs
87− $(ghc) $(ghc-hpc-flags) $(ghc-opt-flags) --make -c -o $@ $<
88−
89−.PHONY: testdata
90−testdata: text-testdata.tar.bz2
91−
92−text-testdata.tar.bz2:
93− curl -O http://projects.haskell.org/text/text-testdata.tar.bz2
94−
95−clean:
96− -rm -rf *.o *.hi *.tix qc qc-hpc stdio-hpc hpcdir .hpc coverage-html
tests/QuickCheckUtils.hsdeleted−155
@@ -1,155 +0,0 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−
3−module QuickCheckUtils where
4−
5−import Control.Arrow (first)
6−import Data.Char (chr)
7−import Data.Bits ((.&.))
8−import Data.String (IsString, fromString)
9−import qualified Data.Text as T
10−import Data.Text.Foreign (I16)
11−import qualified Data.Text.Lazy as TL
12−import System.Random (Random(..), RandomGen)
13−import Test.QuickCheck hiding ((.&.))
14−import qualified Data.ByteString as B
15−
16−instance Random I16 where
17− randomR = integralRandomR
18− random = randomR (minBound,maxBound)
19−
20−instance Arbitrary I16 where
21− arbitrary = choose (minBound,maxBound)
22−
23−instance Arbitrary B.ByteString where
24− arbitrary = B.pack `fmap` arbitrary
25−
26−genUnicode :: IsString a => Gen a
27−genUnicode = fmap fromString string where
28− string = sized $ \n ->
29− do k <- choose (0,n)
30− sequence [ char | _ <- [1..k] ]
31−
32− excluding :: [a -> Bool] -> Gen a -> Gen a
33− excluding bad gen = loop
34− where
35− loop = do
36− x <- gen
37− if or (map ($ x) bad)
38− then loop
39− else return x
40−
41− reserved = [lowSurrogate, highSurrogate, noncharacter]
42− lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
43− highSurrogate c = c >= 0xD800 && c <= 0xDBFF
44− noncharacter c = masked == 0xFFFE || masked == 0xFFFF
45− where
46− masked = c .&. 0xFFFF
47−
48− ascii = choose (0,0x7F)
49− plane0 = choose (0xF0, 0xFFFF)
50− plane1 = oneof [ choose (0x10000, 0x10FFF)
51− , choose (0x11000, 0x11FFF)
52− , choose (0x12000, 0x12FFF)
53− , choose (0x13000, 0x13FFF)
54− , choose (0x1D000, 0x1DFFF)
55− , choose (0x1F000, 0x1FFFF)
56− ]
57− plane2 = oneof [ choose (0x20000, 0x20FFF)
58− , choose (0x21000, 0x21FFF)
59− , choose (0x22000, 0x22FFF)
60− , choose (0x23000, 0x23FFF)
61− , choose (0x24000, 0x24FFF)
62− , choose (0x25000, 0x25FFF)
63− , choose (0x26000, 0x26FFF)
64− , choose (0x27000, 0x27FFF)
65− , choose (0x28000, 0x28FFF)
66− , choose (0x29000, 0x29FFF)
67− , choose (0x2A000, 0x2AFFF)
68− , choose (0x2B000, 0x2BFFF)
69− , choose (0x2F000, 0x2FFFF)
70− ]
71− plane14 = choose (0xE0000, 0xE0FFF)
72− planes = [ascii, plane0, plane1, plane2, plane14]
73−
74− char = chr `fmap` excluding reserved (oneof planes)
75−
76−-- For tests that have O(n^2) running times or input sizes, resize
77−-- their inputs to the square root of the originals.
78−unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
79−unsquare = forAll smallArbitrary
80−
81−smallArbitrary :: (Arbitrary a, Show a) => Gen a
82−smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
83− where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
84−
85−instance Arbitrary T.Text where
86− arbitrary = T.pack `fmap` arbitrary
87−
88−instance Arbitrary TL.Text where
89− arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
90−
91−newtype NotEmpty a = NotEmpty { notEmpty :: a }
92− deriving (Eq, Ord)
93−
94−instance Show a => Show (NotEmpty a) where
95− show (NotEmpty a) = show a
96−
97−instance Functor NotEmpty where
98− fmap f (NotEmpty a) = NotEmpty (f a)
99−
100−instance Arbitrary a => Arbitrary (NotEmpty [a]) where
101− arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
102−
103−instance Arbitrary (NotEmpty T.Text) where
104− arbitrary = (fmap T.pack) `fmap` arbitrary
105−
106−instance Arbitrary (NotEmpty TL.Text) where
107− arbitrary = (fmap TL.pack) `fmap` arbitrary
108−
109−instance Arbitrary (NotEmpty B.ByteString) where
110− arbitrary = (fmap B.pack) `fmap` arbitrary
111−
112−data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
113− | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
114− | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23
115− | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31
116− deriving (Eq, Ord, Enum, Bounded)
117−
118−small :: Integral a => Small -> a
119−small = fromIntegral . fromEnum
120−
121−intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)
122−
123−instance Show Small where
124− show = show . fromEnum
125−
126−instance Read Small where
127− readsPrec n = map (first toEnum) . readsPrec n
128−
129−instance Num Small where
130− fromInteger = toEnum . fromIntegral
131− signum _ = 1
132− abs = id
133− (+) = intf (+)
134− (-) = intf (-)
135− (*) = intf (*)
136−
137−instance Real Small where
138− toRational = toRational . fromEnum
139−
140−instance Integral Small where
141− toInteger = toInteger . fromEnum
142− quotRem a b = (toEnum x, toEnum y)
143− where (x, y) = fromEnum a `quotRem` fromEnum b
144−
145−instance Random Small where
146− randomR = integralRandomR
147− random = randomR (minBound,maxBound)
148−
149−instance Arbitrary Small where
150− arbitrary = choose (minBound,maxBound)
151−
152−integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
153−integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
154− fromIntegral b :: Integer) g of
155− (x,h) -> (fromIntegral x, h)
tests/README.markdown+15−1
@@ -15,7 +15,21 @@ properties), and benchmarks.
15Functional tests
15Functional tests
16----------------
16----------------
17
17
18−TODO
18+The functional tests are located in the `tests` subdirectory. An overview of
19+what's in that directory:
20+
21+ scripts Various utility scripts
22+ src Source files of the testing code
23+ text-tests.cabal Cabal file which compiles all benchmarks
24+ Makefile Has targets for common tasks
25+
26+The `text-tests.cabal` builds:
27+
28+- A copy of the text library, sharing the source code, but exposing all internal
29+ modules, for testing purposes
30+- The different test suites
31+
32+To compile, run all tests, and generate a coverage report, simply use `make`.
19
33
20Benchmarks
34Benchmarks
21----------
35----------
tests/SearchBench.hsdeleted−115
@@ -1,115 +0,0 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2−
3−import Criterion.Main
4−import Data.Text.Encoding
5−import Data.Text.Search
6−import qualified Data.ByteString.Char8 as B
7−import qualified Data.Text as T
8−import qualified SlowFunctions as Slow
9−
10−main = defaultMain [
11− bench "big/fast" $ (length . search indices)
12− , bench "big/slow" $ (length . search Slow.indices)
13− , bench "big/bytestring" $ (length . searchBS)
14− , bench "dna/fast" $ (length . searchDNA indices)
15− , bench "dna/slow" $ (length . searchDNA Slow.indices)
16− , bench "dna/bytestring" $ (length . searchDNABS)
17− ]
18−
19−search f n = f needle' haystack
20− where
21− needle' = T.drop (n `mod` 20) needle
22− needle = T.replicate 10 "abcdefghijklmnopqrstuvwxyz"
23− haystack = T.replicate 100 $
24− T.concat [ T.replicate 1000 "def"
25− , needle
26− , T.replicate 1000 "123"
27− ]
28−
29−searchDNA f n = f needle haystack
30− where
31− needle = T.take 4 . T.drop (n `mod` (T.length dna - 4)) $ dna
32− haystack = T.replicate 100 dna
33−
34−replicateBS n = B.concat . replicate n
35−
36−searchBS n = indicesBS needle' haystack
37− where
38− needle' = B.drop (n `mod` 20) needle
39− needle = replicateBS 10 "abcdefghijklmnopqrstuvwxyz"
40− haystack = replicateBS 100 $
41− B.concat [ replicateBS 1000 "def"
42− , needle
43− , replicateBS 1000 "123"
44− ]
45−
46−searchDNABS n = indicesBS needle haystack
47− where
48− needle = B.take 4 . B.drop (n `mod` (B.length bdna - 4)) $ bdna
49− haystack = replicateBS 100 bdna
50−
51−indicesBS :: B.ByteString -> B.ByteString -> [Int]
52−indicesBS pat
53− | B.null pat = error "empty"
54− | otherwise = go 0
55− where
56− l = B.length pat
57− go !i src = case B.breakSubstring pat src of
58− (h,t) | B.null t -> []
59− | otherwise -> i' : go (i'+l) (B.drop l t)
60− where i' = i + B.length h
61−
62−dna = decodeASCII bdna
63−
64−bdna :: B.ByteString
65−bdna = "\
66−\CGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGGGTT\
67−\AATCTGGAGGATCTGTTTACTTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGAATTGCCATCG\
68−\AGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGCAGTTTTGCTCCAAGTCGTT\
69−\TGACACATAATTGGTGAAGGGGGTGGCATCCTTCCCTGACCCTCCCCCAACTATTTTTTTAACAACTCTC\
70−\AGCAACGGAGACTCAGTCTTCGGCAAATGCGATAAATGGTGTGAATTGCAGAATCCCGTGCACCATCGAG\
71−\TCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCATTGCGAGTCATAT\
72−\CTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCGGATGTGAGTTTGGCCCCTTGTTCTT\
73−\TGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAGGTGGACGAACTAT\
74−\GCTACAACAAAATTGTTGTGCAGAGGCCCCGGGTTGTCGTATTAGATGGGCCACCGTAATCTGAAGACCC\
75−\TTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGCGACCCCAGGTCAG\
76−\GTGAGCAACAGCTGTCGTAACAAGGTTTCCGTAGGGTGAACTGCGGAAGGATCATTGTTGAGATCACATA\
77−\ATAATTGATCGAGTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGAC\
78−\CTAGATTTGCCATCGAGCCTCCTTGGGAGCATCCTTGTTGGCGATATCTAAACCCTCAATTTTTCCCCCA\
79−\ATCAAATTACACAAAATTGGTGGAGGGGGTGGCATTCTTCCCTTACCCTCCCCCAAATATTTTTTTAACA\
80−\ACTCTCAGCAACGGATATCTCAGCTCTTGCATCGATGAAGAACCCACCGAAATGCGATAAATGGTGTGAA\
81−\TTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACG\
82−\CCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCG\
83−\GATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGATGCATGGGCTTTTGATGGTCCTAA\
84−\ATACGGCAAGAGGTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATAAG\
85−\ATGGGCCACCGATATCTGAAGACCCTTTTGGACCCCATTGGAGCCCATCAACCCATGTCAGTTGATGGCC\
86−\ATTCGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGA\
87−\GTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCA\
88−\TCGAGCCTCCTTGGGAGCTTTCTTGTTGGCGATATCTAAACCCTTGCCCGGCAGAGTTTTGGGAATCCCG\
89−\TGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCAT\
90−\TGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACACACCTGTTCAGCCGGTGCGGATGTGAGTTTG\
91−\GCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAG\
92−\GTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATTAGATGGGCCACCAT\
93−\AATCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGC\
94−\GACCCAGTCAGGTGAGGGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGAG\
95−\TTAATCTGGAGGATCTGTTTACTTTGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCAT\
96−\CGAGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTTGGCGCCAAGTCA\
97−\TATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAACAACTC\
98−\TCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGAATTGC\
99−\AGAATCCCGTGAACCATCGAGTCTTTGGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCT\
100−\GCCTGGGCATTGGGAATCATATCTCTCCCCTAACGAGGCTATCCAAACATACTGTTCATCCGGTGCGGAT\
101−\GTGAGTTTGGCCCCTTGTTCTTTGGTACCGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTCAAAA\
102−\CGGCAAGAGGTGGACGAACTATGCCACAACAAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTAGATG\
103−\GGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGACCA\
104−\TTTGTTGCGACCCCAGTCAGCTGAGCAACCCGCTGAGTGGAAGGTCATTGCCGATATCACATAATAATTG\
105−\ATCGAGTTAATCTGGAGGATCTGTTTACTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGATTT\
106−\GCCATCGAGCCTCCTTGGGAGTTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTGTGCGCCA\
107−\AGTCATATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAAC\
108−\AACTCTCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGA\
109−\ATTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCAC\
110−\GCCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCATCCGGTGC\
111−\GGATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTC\
112−\AAAACGGCAAGAGGTGGACGAACTATGCTACAACCAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTA\
113−\GATGGGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATG\
114−\ACCATGTGTTGCGACCCCAGTCAGCTGAGCAACGCGCTGAGCGTAACAAGGTTTCCGTAGGTGGACCTCC\
115−\GGGAGGATCATTGTTGAGATCACATAATAATTGATCGAGGTAATCTGGAGGATCTGCATATTTTGGTCAC"
tests/TestUtils.hsdeleted−31
@@ -1,31 +0,0 @@
1−module TestUtils
2− (
3− withRedirect
4− , withTempFile
5− ) where
6−
7−import Control.Exception (bracket, bracket_)
8−import Control.Monad (when)
9−import GHC.IO.Handle.Internals (withHandle)
10−import System.Directory (removeFile)
11−import System.IO
12−
13−withTempFile :: (FilePath -> Handle -> IO a) -> IO a
14−withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
15− where
16− cleanupTemp (path,h) = do
17− open <- hIsOpen h
18− when open (hClose h)
19− removeFile path
20−
21−withRedirect :: Handle -> Handle -> IO a -> IO a
22−withRedirect tmp h = bracket_ swap swap
23− where
24− whenM p a = p >>= (`when` a)
25− swap = do
26− whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp
27− whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h
28− withHandle "spam" tmp $ \tmph -> do
29− hh <- withHandle "spam" h $ \hh ->
30− return (tmph,hh)
31− return (hh,())
tests/tests/.ghcinew file+1
@@ -0,0 +1 @@
1+:set -DHAVE_DEEPSEQ -isrc -i../..
tests/tests/Makefilenew file+29
@@ -0,0 +1,29 @@
1+coverage: build coverage/hpc_index.html
2+
3+build:
4+ cabal configure -fhpc
5+ cabal build
6+
7+coverage/text-tests.tix:
8+ -mkdir -p coverage
9+ ./dist/build/text-tests/text-tests
10+ mv text-tests.tix $@
11+
12+coverage/text-tests-stdio.tix:
13+ -mkdir -p coverage
14+ ./scripts/cover-stdio.sh ./dist/build/text-tests-stdio/text-tests-stdio
15+ mv text-tests-stdio.tix $@
16+
17+coverage/coverage.tix: coverage/text-tests.tix coverage/text-tests-stdio.tix
18+ hpc combine --output=$@ \
19+ --exclude=Main \
20+ coverage/text-tests.tix \
21+ coverage/text-tests-stdio.tix
22+
23+coverage/hpc_index.html: coverage/coverage.tix
24+ hpc markup --destdir=coverage coverage/coverage.tix
25+
26+clean:
27+ rm -rf dist coverage .hpc
28+
29+.PHONY: build coverage
tests/cover-stdio.sh → tests/tests/scripts/cover-stdio.shrenamed+6−1
@@ -1,6 +1,11 @@
1#!/bin/bash
1#!/bin/bash
2
2
3+if [[ $# < 1 ]]; then
4+ echo "Usage: $0 <exe>"
5+ exit 1
6+fi
7+
3−exe=./stdio-hpc
8+exe=$1
4
9
5rm -f $exe.tix
10rm -f $exe.tix
6
11
tests/tests/src/Data/Text/Tests.hsnew file+13
@@ -0,0 +1,13 @@
1+-- | Provides a simple main function which runs all the tests
2+--
3+module Main
4+ ( main
5+ ) where
6+
7+import Test.Framework (defaultMain)
8+
9+import qualified Data.Text.Tests.Properties as Properties
10+import qualified Data.Text.Tests.Regressions as Regressions
11+
12+main :: IO ()
13+main = defaultMain [Properties.tests, Regressions.tests]
tests/StdioCoverage.hs → tests/tests/src/Data/Text/Tests/IO.hsrenamed+12−3
@@ -1,11 +1,20 @@
1+-- | Program which exposes some haskell functions as an exutable. The results
2+-- and coverage of this module is meant to be checked using a shell script.
3+--
4+module Main
5+ (
6+ main
7+ ) where
8+
9+import System.Environment (getArgs)
10+import System.Exit (exitFailure)
11+import System.IO (hPutStrLn, stderr)
1import qualified Data.Text as T
12import qualified Data.Text as T
2import qualified Data.Text.IO as T
13import qualified Data.Text.IO as T
3import qualified Data.Text.Lazy as TL
14import qualified Data.Text.Lazy as TL
4import qualified Data.Text.Lazy.IO as TL
15import qualified Data.Text.Lazy.IO as TL
5−import System.Environment (getArgs)
6−import System.Exit (exitFailure)
7−import System.IO (hPutStrLn, stderr)
8
16
17+main :: IO ()
9main = do
18main = do
10 args <- getArgs
19 args <- getArgs
11 case args of
20 case args of
tests/Properties.hs → tests/tests/src/Data/Text/Tests/Properties.hsrenamed+463−587
@@ -1,65 +1,54 @@
1+-- | General quicktest properties for the text library
2+--
1{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
2 ScopedTypeVariables, TypeSynonymInstances, CPP #-}
4 ScopedTypeVariables, TypeSynonymInstances, CPP #-}
3{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
5{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
6+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
7+module Data.Text.Tests.Properties
8+ (
9+ tests
10+ ) where
4
11
5import Test.QuickCheck
12import Test.QuickCheck
6import Test.QuickCheck.Monadic
13import Test.QuickCheck.Monadic
7import Text.Show.Functions ()
14import Text.Show.Functions ()
8
15
9−import qualified Data.Bits as Bits (shiftL, shiftR)
16+import Control.Arrow ((***), second)
10−import Numeric (showHex)
17+import Control.Exception (catch)
11import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
18import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
12import Data.Monoid (Monoid(..))
19import Data.Monoid (Monoid(..))
13import Data.String (fromString)
20import Data.String (fromString)
14−import Debug.Trace (trace)
21+import Data.Text.Encoding.Error
15−import Control.Arrow ((***), second)
22+import Data.Text.Foreign
16−import Control.DeepSeq
23+import Data.Text.Fusion.Size
24+import Data.Text.Lazy.Read as TL
25+import Data.Text.Read as T
26+import Data.Text.Search (indices)
17import Data.Word (Word8, Word16, Word32)
27import Data.Word (Word8, Word16, Word32)
28+import Numeric (showHex)
29+import Prelude hiding (catch, replicate)
30+import Test.Framework (Test, testGroup)
31+import Test.Framework.Providers.QuickCheck2 (testProperty)
32+import qualified Data.Bits as Bits (shiftL, shiftR)
33+import qualified Data.ByteString as B
34+import qualified Data.List as L
18import qualified Data.Text as T
35import qualified Data.Text as T
19−import qualified Data.Text.IO as T
20−import qualified Data.Text.Lazy as TL
21−import qualified Data.Text.Lazy.IO as TL
22−import qualified Data.Text.Lazy.Internal as TL
23−import qualified Data.Text.Lazy.Builder as TB
24import qualified Data.Text.Encoding as E
36import qualified Data.Text.Encoding as E
25−import Data.Text.Read as T
26−import Data.Text.Lazy.Read as TL
27−import Data.Text.Encoding.Error
28−import Control.Exception (SomeException, bracket, catch, evaluate, try)
29−import Data.Text.Foreign
30import qualified Data.Text.Fusion as S
37import qualified Data.Text.Fusion as S
31import qualified Data.Text.Fusion.Common as S
38import qualified Data.Text.Fusion.Common as S
32−import Data.Text.Fusion.Size
39+import qualified Data.Text.IO as T
40+import qualified Data.Text.Lazy as TL
41+import qualified Data.Text.Lazy.Builder as TB
33import qualified Data.Text.Lazy.Encoding as EL
42import qualified Data.Text.Lazy.Encoding as EL
34import qualified Data.Text.Lazy.Fusion as SL
43import qualified Data.Text.Lazy.Fusion as SL
35−import qualified Data.Text.UnsafeShift as U
44+import qualified Data.Text.Lazy.IO as TL
36−import qualified Data.List as L
37−import Prelude hiding (catch, replicate)
38−import System.IO
39−import System.IO.Unsafe (unsafePerformIO)
40−import Test.Framework (defaultMain, testGroup)
41−import Test.Framework.Providers.QuickCheck2 (testProperty)
42−import Data.Text.Search (indices)
43import qualified Data.Text.Lazy.Search as S (indices)
45import qualified Data.Text.Lazy.Search as S (indices)
46+import qualified Data.Text.UnsafeShift as U
47+import qualified System.IO as IO
48+
49+import Data.Text.Tests.QuickCheckUtils
50+import Data.Text.Tests.Utils
44−import qualified SlowFunctions as Slow
51+import qualified Data.Text.Tests.SlowFunctions as Slow
45−
46−import QuickCheckUtils (NotEmpty(..), genUnicode, small, unsquare)
47−import TestUtils (withRedirect, withTempFile)
48−
49−-- Ensure that two potentially bottom values (in the sense of crashing
50−-- for some inputs, not looping infinitely) either both crash, or both
51−-- give comparable results for some input.
52−(=^=) :: (Eq a, Show a) => a -> a -> Bool
53−{-# NOINLINE (=^=) #-}
54−i =^= j = unsafePerformIO $ do
55− x <- try (evaluate i)
56− y <- try (evaluate j)
57− case (x,y) of
58− (Left (_ :: SomeException), Left (_ :: SomeException))
59− -> return True
60− (Right a, Right b) -> return (a == b)
61− e -> trace ("*** Divergence: " ++ show e) return False
62−infix 4 =^=
63
52
64t_pack_unpack = (T.unpack . T.pack) `eq` id
53t_pack_unpack = (T.unpack . T.pack) `eq` id
65tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
54tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
@@ -90,20 +79,10 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
90t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
79t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
91tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
80tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
92
81
93−data DecodeErr = DE String OnDecodeError
94−
95−instance Show DecodeErr where
96− show (DE d _) = "DE " ++ d
97−
98−instance Arbitrary DecodeErr where
99− arbitrary = oneof [ return $ DE "lenient" lenientDecode
100− , return $ DE "ignore" ignore
101− , return $ DE "strict" strictDecode
102− , DE "replace" `fmap` arbitrary ]
103−
104-- This is a poor attempt to ensure that the error handling paths on
82-- This is a poor attempt to ensure that the error handling paths on
105-- decode are exercised in some way. Proper testing would be rather
83-- decode are exercised in some way. Proper testing would be rather
106-- more involved.
84-- more involved.
85+t_utf8_err :: DecodeErr -> B.ByteString -> Property
107t_utf8_err (DE _ de) bs = monadicIO $ do
86t_utf8_err (DE _ de) bs = monadicIO $ do
108 l <- run $ let len = T.length (E.decodeUtf8With de bs)
87 l <- run $ let len = T.length (E.decodeUtf8With de bs)
109 in (len `seq` return (Right len)) `catch`
88 in (len `seq` return (Right len)) `catch`
@@ -112,62 +91,11 @@ t_utf8_err (DE _ de) bs = monadicIO $ do
112 Left err -> assert $ length (show err) >= 0
91 Left err -> assert $ length (show err) >= 0
113 Right n -> assert $ n >= 0
92 Right n -> assert $ n >= 0
114
93
94+t_utf8_err' :: B.ByteString -> Property
115t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
95t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
116 Left err -> length (show err) >= 0
96 Left err -> length (show err) >= 0
117 Right t -> T.length t >= 0
97 Right t -> T.length t >= 0
118
98
119−class Stringy s where
120− packS :: String -> s
121− unpackS :: s -> String
122− splitAtS :: Int -> s -> (s,s)
123− packSChunkSize :: Int -> String -> s
124− packSChunkSize _ = packS
125−
126−instance Stringy String where
127− packS = id
128− unpackS = id
129− splitAtS = splitAt
130−
131−instance Stringy (S.Stream Char) where
132− packS = S.streamList
133− unpackS = S.unstreamList
134− splitAtS n s = (S.take n s, S.drop n s)
135−
136−instance Stringy T.Text where
137− packS = T.pack
138− unpackS = T.unpack
139− splitAtS = T.splitAt
140−
141−instance Stringy TL.Text where
142− packSChunkSize k = SL.unstreamChunks k . S.streamList
143− packS = TL.pack
144− unpackS = TL.unpack
145− splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .
146− TL.splitAt . fromIntegral
147−
148−-- Do two functions give the same answer?
149−eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
150−eq a b s = a s =^= b s
151−
152−-- What about with the RHS packed?
153−eqP :: (Eq a, Show a, Stringy s) =>
154− (String -> a) -> (s -> a) -> String -> Word8 -> Bool
155−eqP f g s w = eql "orig" (f s) (g t) &&
156− eql "mini" (f s) (g mini) &&
157− eql "head" (f sa) (g ta) &&
158− eql "tail" (f sb) (g tb)
159− where t = packS s
160− mini = packSChunkSize 10 s
161− (sa,sb) = splitAt m s
162− (ta,tb) = splitAtS m t
163− l = length s
164− m | l == 0 = n
165− | otherwise = n `mod` l
166− n = fromIntegral w
167− eql d a b
168− | a =^= b = True
169− | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
170−
171s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
99s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
172 where _types = s :: String
100 where _types = s :: String
173sf_Eq p s =
101sf_Eq p s =
@@ -253,6 +181,8 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
253sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
181sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
254t_map f = map f `eqP` (unpackS . T.map f)
182t_map f = map f `eqP` (unpackS . T.map f)
255tl_map f = map f `eqP` (unpackS . TL.map f)
183tl_map f = map f `eqP` (unpackS . TL.map f)
184+s_intercalate c = L.intercalate c `eq`
185+ (unpackS . S.intercalate (packS c) . map packS)
256t_intercalate c = L.intercalate c `eq`
186t_intercalate c = L.intercalate c `eq`
257 (unpackS . T.intercalate (packS c) . map packS)
187 (unpackS . T.intercalate (packS c) . map packS)
258tl_intercalate c = L.intercalate c `eq`
188tl_intercalate c = L.intercalate c `eq`
@@ -415,6 +345,9 @@ tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
415
345
416replicate n l = concat (L.replicate n l)
346replicate n l = concat (L.replicate n l)
417
347
348+s_replicate n = replicate m `eq`
349+ (unpackS . S.replicateI (fromIntegral m) . packS)
350+ where m = fromIntegral (n :: Word8)
418t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)
351t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)
419 where m = fromIntegral (n :: Word8)
352 where m = fromIntegral (n :: Word8)
420tl_replicate n = replicate m `eq`
353tl_replicate n = replicate m `eq`
@@ -497,14 +430,18 @@ t_breakOn_id s = squid `eq` (uncurry T.append . T.breakOn s)
497tl_breakOn_id s = squid `eq` (uncurry TL.append . TL.breakOn s)
430tl_breakOn_id s = squid `eq` (uncurry TL.append . TL.breakOn s)
498 where squid t | TL.null s = error "empty"
431 where squid t | TL.null s = error "empty"
499 | otherwise = t
432 | otherwise = t
500−t_breakOn_start (NotEmpty s) t = let (_,m) = T.breakOn s t
433+t_breakOn_start (NotEmpty s) t =
434+ let (k,m) = T.breakOn s t
501− in T.null m || s `T.isPrefixOf` m
435+ in k `T.isPrefixOf` t && (T.null m || s `T.isPrefixOf` m)
502−tl_breakOn_start (NotEmpty s) t = let (_,m) = TL.breakOn s t
436+tl_breakOn_start (NotEmpty s) t =
437+ let (k,m) = TL.breakOn s t
503− in TL.null m || s `TL.isPrefixOf` m
438+ in k `TL.isPrefixOf` t && TL.null m || s `TL.isPrefixOf` m
504−t_breakOnEnd_end (NotEmpty s) t = let (m,_) = T.breakOnEnd s t
439+t_breakOnEnd_end (NotEmpty s) t =
440+ let (m,k) = T.breakOnEnd s t
505− in T.null m || s `T.isSuffixOf` m
441+ in k `T.isSuffixOf` t && (T.null m || s `T.isSuffixOf` m)
506−tl_breakOnEnd_end (NotEmpty s) t = let (m,_) = TL.breakOnEnd s t
442+tl_breakOnEnd_end (NotEmpty s) t =
443+ let (m,k) = TL.breakOnEnd s t
507− in TL.null m || s `TL.isSuffixOf` m
444+ in k `TL.isSuffixOf` t && (TL.null m || s `TL.isSuffixOf` m)
508t_break p = L.break p `eqP` (unpack2 . T.break p)
445t_break p = L.break p `eqP` (unpack2 . T.break p)
509tl_break p = L.break p `eqP` (unpack2 . TL.break p)
446tl_break p = L.break p `eqP` (unpack2 . TL.break p)
510t_group = L.group `eqP` (map unpackS . T.group)
447t_group = L.group `eqP` (map unpackS . T.group)
@@ -722,75 +659,12 @@ tl_rational = tl_read_rational TL.rational 1e-16
722
659
723-- Input and output.
660-- Input and output.
724
661
725−-- Work around lack of Show instance for TextEncoding.
726−data Encoding = E String TextEncoding
727−
728−instance Show Encoding where show (E n _) = "utf" ++ n
729−
730−instance Arbitrary Encoding where
731− arbitrary = oneof . map return $
732− [ E "8" utf8, E "8_bom" utf8_bom, E "16" utf16, E "16le" utf16le,
733− E "16be" utf16be, E "32" utf32, E "32le" utf32le, E "32be" utf32be ]
734−
735−windowsNewlineMode = NewlineMode { inputNL = CRLF, outputNL = CRLF }
736−
737−-- Newline and NewlineMode have standard Show instance from GHC 7 onwards
738−#if __GLASGOW_HASKELL__ < 700
739−instance Show Newline where
740− show CRLF = "CRLF"
741− show LF = "LF"
742−
743−instance Show NewlineMode where
744− show (NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++
745− ", outputNL = " ++ show o ++ " }"
746−# endif
747−
748−instance Arbitrary NewlineMode where
749− arbitrary = oneof . map return $
750− [ noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
751− windowsNewlineMode ]
752−
753−instance Arbitrary BufferMode where
754− arbitrary = oneof [ return NoBuffering,
755− return LineBuffering,
756− return (BlockBuffering Nothing),
757− (BlockBuffering . Just . (+1) . fromIntegral) `fmap`
758− (arbitrary :: Gen Word16) ]
759−
760−-- This test harness is complex! What property are we checking?
761−--
762−-- Reading after writing a multi-line file should give the same
763−-- results as were written.
764−--
765−-- What do we vary while checking this property?
766−-- * The lines themselves, scrubbed to contain neither CR nor LF. (By
767−-- working with a list of lines, we ensure that the data will
768−-- sometimes contain line endings.)
769−-- * Encoding.
770−-- * Newline translation mode.
771−-- * Buffering.
772−write_read unline filt writer reader (E _ enc) nl buf ts =
773− monadicIO $ assert . (==t) =<< run act
774− where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
775− act = withTempFile $ \path h -> do
776− -- hSetEncoding h enc
777− hSetNewlineMode h nl
778− hSetBuffering h buf
779− () <- writer h t
780− hClose h
781− bracket (openFile path ReadMode) hClose $ \h' -> do
782− -- hSetEncoding h' enc
783− hSetNewlineMode h' nl
784− hSetBuffering h' buf
785− r <- reader h'
786− r `deepseq` return r
787−
788t_put_get = write_read T.unlines T.filter put get
662t_put_get = write_read T.unlines T.filter put get
789− where put h = withRedirect h stdout . T.putStr
663+ where put h = withRedirect h IO.stdout . T.putStr
790− get h = withRedirect h stdin T.getContents
664+ get h = withRedirect h IO.stdin T.getContents
791tl_put_get = write_read TL.unlines TL.filter put get
665tl_put_get = write_read TL.unlines TL.filter put get
792− where put h = withRedirect h stdout . TL.putStr
666+ where put h = withRedirect h IO.stdout . TL.putStr
793− get h = withRedirect h stdin TL.getContents
667+ get h = withRedirect h IO.stdin TL.getContents
794t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
668t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
795tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
669tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
796
670
@@ -820,421 +694,423 @@ shorten n t@(S.Stream arr off len)
820 | n > 0 = S.Stream arr off (smaller (exactSize n) len)
694 | n > 0 = S.Stream arr off (smaller (exactSize n) len)
821 | otherwise = t
695 | otherwise = t
822
696
823−main = defaultMain tests
697+tests :: Test
824−
825−tests = [
698+tests =
699+ testGroup "Properties" [
826− testGroup "creation/elimination" [
700+ testGroup "creation/elimination" [
827− testProperty "t_pack_unpack" t_pack_unpack,
701+ testProperty "t_pack_unpack" t_pack_unpack,
828− testProperty "tl_pack_unpack" tl_pack_unpack,
702+ testProperty "tl_pack_unpack" tl_pack_unpack,
829− testProperty "t_stream_unstream" t_stream_unstream,
703+ testProperty "t_stream_unstream" t_stream_unstream,
830− testProperty "tl_stream_unstream" tl_stream_unstream,
704+ testProperty "tl_stream_unstream" tl_stream_unstream,
831− testProperty "t_reverse_stream" t_reverse_stream,
705+ testProperty "t_reverse_stream" t_reverse_stream,
832− testProperty "t_singleton" t_singleton,
706+ testProperty "t_singleton" t_singleton,
833− testProperty "tl_singleton" tl_singleton,
707+ testProperty "tl_singleton" tl_singleton,
834− testProperty "tl_unstreamChunks" tl_unstreamChunks,
708+ testProperty "tl_unstreamChunks" tl_unstreamChunks,
835− testProperty "tl_chunk_unchunk" tl_chunk_unchunk,
709+ testProperty "tl_chunk_unchunk" tl_chunk_unchunk,
836− testProperty "tl_from_to_strict" tl_from_to_strict
710+ testProperty "tl_from_to_strict" tl_from_to_strict
837− ],
838−
839− testGroup "transcoding" [
840− testProperty "t_ascii" t_ascii,
841− testProperty "tl_ascii" tl_ascii,
842− testProperty "t_utf8" t_utf8,
843− testProperty "t_utf8'" t_utf8',
844− testProperty "tl_utf8" tl_utf8,
845− testProperty "tl_utf8'" tl_utf8',
846− testProperty "t_utf16LE" t_utf16LE,
847− testProperty "tl_utf16LE" tl_utf16LE,
848− testProperty "t_utf16BE" t_utf16BE,
849− testProperty "tl_utf16BE" tl_utf16BE,
850− testProperty "t_utf32LE" t_utf32LE,
851− testProperty "tl_utf32LE" tl_utf32LE,
852− testProperty "t_utf32BE" t_utf32BE,
853− testProperty "tl_utf32BE" tl_utf32BE,
854− testGroup "errors" [
855− testProperty "t_utf8_err" t_utf8_err,
856− testProperty "t_utf8_err'" t_utf8_err'
857− ]
858− ],
859−
860− testGroup "instances" [
861− testProperty "s_Eq" s_Eq,
862− testProperty "sf_Eq" sf_Eq,
863− testProperty "t_Eq" t_Eq,
864− testProperty "tl_Eq" tl_Eq,
865− testProperty "s_Ord" s_Ord,
866− testProperty "sf_Ord" sf_Ord,
867− testProperty "t_Ord" t_Ord,
868− testProperty "tl_Ord" tl_Ord,
869− testProperty "t_Read" t_Read,
870− testProperty "tl_Read" tl_Read,
871− testProperty "t_Show" t_Show,
872− testProperty "tl_Show" tl_Show,
873− testProperty "t_mappend" t_mappend,
874− testProperty "tl_mappend" tl_mappend,
875− testProperty "t_mconcat" t_mconcat,
876− testProperty "tl_mconcat" tl_mconcat,
877− testProperty "t_mempty" t_mempty,
878− testProperty "tl_mempty" tl_mempty,
879− testProperty "t_IsString" t_IsString,
880− testProperty "tl_IsString" tl_IsString
881− ],
882−
883− testGroup "basics" [
884− testProperty "s_cons" s_cons,
885− testProperty "s_cons_s" s_cons_s,
886− testProperty "sf_cons" sf_cons,
887− testProperty "t_cons" t_cons,
888− testProperty "tl_cons" tl_cons,
889− testProperty "s_snoc" s_snoc,
890− testProperty "t_snoc" t_snoc,
891− testProperty "tl_snoc" tl_snoc,
892− testProperty "s_append" s_append,
893− testProperty "s_append_s" s_append_s,
894− testProperty "sf_append" sf_append,
895− testProperty "t_append" t_append,
896− testProperty "s_uncons" s_uncons,
897− testProperty "sf_uncons" sf_uncons,
898− testProperty "t_uncons" t_uncons,
899− testProperty "tl_uncons" tl_uncons,
900− testProperty "s_head" s_head,
901− testProperty "sf_head" sf_head,
902− testProperty "t_head" t_head,
903− testProperty "tl_head" tl_head,
904− testProperty "s_last" s_last,
905− testProperty "sf_last" sf_last,
906− testProperty "t_last" t_last,
907− testProperty "tl_last" tl_last,
908− testProperty "s_tail" s_tail,
909− testProperty "s_tail_s" s_tail_s,
910− testProperty "sf_tail" sf_tail,
911− testProperty "t_tail" t_tail,
912− testProperty "tl_tail" tl_tail,
913− testProperty "s_init" s_init,
914− testProperty "s_init_s" s_init_s,
915− testProperty "sf_init" sf_init,
916− testProperty "t_init" t_init,
917− testProperty "tl_init" tl_init,
918− testProperty "s_null" s_null,
919− testProperty "sf_null" sf_null,
920− testProperty "t_null" t_null,
921− testProperty "tl_null" tl_null,
922− testProperty "s_length" s_length,
923− testProperty "sf_length" sf_length,
924− testProperty "sl_length" sl_length,
925− testProperty "t_length" t_length,
926− testProperty "tl_length" tl_length,
927− testProperty "t_compareLength" t_compareLength,
928− testProperty "tl_compareLength" tl_compareLength
929− ],
930−
931− testGroup "transformations" [
932− testProperty "s_map" s_map,
933− testProperty "s_map_s" s_map_s,
934− testProperty "sf_map" sf_map,
935− testProperty "t_map" t_map,
936− testProperty "tl_map" tl_map,
937− testProperty "t_intercalate" t_intercalate,
938− testProperty "tl_intercalate" tl_intercalate,
939− testProperty "s_intersperse" s_intersperse,
940− testProperty "s_intersperse_s" s_intersperse_s,
941− testProperty "sf_intersperse" sf_intersperse,
942− testProperty "t_intersperse" t_intersperse,
943− testProperty "tl_intersperse" tl_intersperse,
944− testProperty "t_transpose" t_transpose,
945− testProperty "tl_transpose" tl_transpose,
946− testProperty "t_reverse" t_reverse,
947− testProperty "tl_reverse" tl_reverse,
948− testProperty "t_reverse_short" t_reverse_short,
949− testProperty "t_replace" t_replace,
950− testProperty "tl_replace" tl_replace,
951−
952− testGroup "case conversion" [
953− testProperty "s_toCaseFold_length" s_toCaseFold_length,
954− testProperty "sf_toCaseFold_length" sf_toCaseFold_length,
955− testProperty "t_toCaseFold_length" t_toCaseFold_length,
956− testProperty "tl_toCaseFold_length" tl_toCaseFold_length,
957− testProperty "t_toLower_length" t_toLower_length,
958− testProperty "t_toLower_lower" t_toLower_lower,
959− testProperty "tl_toLower_lower" tl_toLower_lower,
960− testProperty "t_toUpper_length" t_toUpper_length,
961− testProperty "t_toUpper_upper" t_toUpper_upper,
962− testProperty "tl_toUpper_upper" tl_toUpper_upper
963 ],
711 ],
964
712
965− testGroup "justification" [
713+ testGroup "transcoding" [
966− testProperty "s_justifyLeft" s_justifyLeft,
967− testProperty "s_justifyLeft_s" s_justifyLeft_s,
968− testProperty "sf_justifyLeft" sf_justifyLeft,
969− testProperty "t_justifyLeft" t_justifyLeft,
970− testProperty "tl_justifyLeft" tl_justifyLeft,
971− testProperty "t_justifyRight" t_justifyRight,
972− testProperty "tl_justifyRight" tl_justifyRight,
973− testProperty "t_center" t_center,
974− testProperty "tl_center" tl_center
975− ]
976− ],
977−
978− testGroup "folds" [
979− testProperty "sf_foldl" sf_foldl,
980− testProperty "t_foldl" t_foldl,
981− testProperty "tl_foldl" tl_foldl,
982− testProperty "sf_foldl'" sf_foldl',
983− testProperty "t_foldl'" t_foldl',
984− testProperty "tl_foldl'" tl_foldl',
985− testProperty "sf_foldl1" sf_foldl1,
986− testProperty "t_foldl1" t_foldl1,
987− testProperty "tl_foldl1" tl_foldl1,
988− testProperty "t_foldl1'" t_foldl1',
989− testProperty "sf_foldl1'" sf_foldl1',
990− testProperty "tl_foldl1'" tl_foldl1',
991− testProperty "sf_foldr" sf_foldr,
992− testProperty "t_foldr" t_foldr,
993− testProperty "tl_foldr" tl_foldr,
994− testProperty "sf_foldr1" sf_foldr1,
995− testProperty "t_foldr1" t_foldr1,
996− testProperty "tl_foldr1" tl_foldr1,
997−
998− testGroup "special" [
999− testProperty "s_concat_s" s_concat_s,
714+ testProperty "t_ascii" t_ascii,
1000− testProperty "sf_concat" sf_concat,
715+ testProperty "tl_ascii" tl_ascii,
1001− testProperty "t_concat" t_concat,
716+ testProperty "t_utf8" t_utf8,
1002− testProperty "tl_concat" tl_concat,
717+ testProperty "t_utf8'" t_utf8',
1003− testProperty "sf_concatMap" sf_concatMap,
718+ testProperty "tl_utf8" tl_utf8,
1004− testProperty "t_concatMap" t_concatMap,
719+ testProperty "tl_utf8'" tl_utf8',
1005− testProperty "tl_concatMap" tl_concatMap,
720+ testProperty "t_utf16LE" t_utf16LE,
1006− testProperty "sf_any" sf_any,
721+ testProperty "tl_utf16LE" tl_utf16LE,
1007− testProperty "t_any" t_any,
722+ testProperty "t_utf16BE" t_utf16BE,
1008− testProperty "tl_any" tl_any,
723+ testProperty "tl_utf16BE" tl_utf16BE,
1009− testProperty "sf_all" sf_all,
724+ testProperty "t_utf32LE" t_utf32LE,
1010− testProperty "t_all" t_all,
725+ testProperty "tl_utf32LE" tl_utf32LE,
1011− testProperty "tl_all" tl_all,
726+ testProperty "t_utf32BE" t_utf32BE,
1012− testProperty "sf_maximum" sf_maximum,
727+ testProperty "tl_utf32BE" tl_utf32BE,
1013− testProperty "t_maximum" t_maximum,
1014− testProperty "tl_maximum" tl_maximum,
1015− testProperty "sf_minimum" sf_minimum,
1016− testProperty "t_minimum" t_minimum,
1017− testProperty "tl_minimum" tl_minimum
1018− ]
1019− ],
1020−
1021− testGroup "construction" [
728+ testGroup "errors" [
1022− testGroup "scans" [
1023− testProperty "sf_scanl" sf_scanl,
729+ testProperty "t_utf8_err" t_utf8_err,
1024− testProperty "t_scanl" t_scanl,
730+ testProperty "t_utf8_err'" t_utf8_err'
1025− testProperty "tl_scanl" tl_scanl,
731+ ]
1026− testProperty "t_scanl1" t_scanl1,
1027− testProperty "tl_scanl1" tl_scanl1,
1028− testProperty "t_scanr" t_scanr,
1029− testProperty "tl_scanr" tl_scanr,
1030− testProperty "t_scanr1" t_scanr1,
1031− testProperty "tl_scanr1" tl_scanr1
1032 ],
732 ],
1033
733
1034− testGroup "mapAccum" [
734+ testGroup "instances" [
1035− testProperty "t_mapAccumL" t_mapAccumL,
735+ testProperty "s_Eq" s_Eq,
1036− testProperty "tl_mapAccumL" tl_mapAccumL,
736+ testProperty "sf_Eq" sf_Eq,
1037− testProperty "t_mapAccumR" t_mapAccumR,
737+ testProperty "t_Eq" t_Eq,
1038− testProperty "tl_mapAccumR" tl_mapAccumR
738+ testProperty "tl_Eq" tl_Eq,
739+ testProperty "s_Ord" s_Ord,
740+ testProperty "sf_Ord" sf_Ord,
741+ testProperty "t_Ord" t_Ord,
742+ testProperty "tl_Ord" tl_Ord,
743+ testProperty "t_Read" t_Read,
744+ testProperty "tl_Read" tl_Read,
745+ testProperty "t_Show" t_Show,
746+ testProperty "tl_Show" tl_Show,
747+ testProperty "t_mappend" t_mappend,
748+ testProperty "tl_mappend" tl_mappend,
749+ testProperty "t_mconcat" t_mconcat,
750+ testProperty "tl_mconcat" tl_mconcat,
751+ testProperty "t_mempty" t_mempty,
752+ testProperty "tl_mempty" tl_mempty,
753+ testProperty "t_IsString" t_IsString,
754+ testProperty "tl_IsString" tl_IsString
1039 ],
755 ],
1040
756
1041− testGroup "unfolds" [
757+ testGroup "basics" [
1042− testProperty "t_replicate" t_replicate,
1043− testProperty "tl_replicate" tl_replicate,
1044− testProperty "t_unfoldr" t_unfoldr,
1045− testProperty "tl_unfoldr" tl_unfoldr,
1046− testProperty "t_unfoldrN" t_unfoldrN,
1047− testProperty "tl_unfoldrN" tl_unfoldrN
1048− ]
1049− ],
1050−
1051− testGroup "substrings" [
1052− testGroup "breaking" [
1053− testProperty "s_take" s_take,
758+ testProperty "s_cons" s_cons,
1054− testProperty "s_take_s" s_take_s,
759+ testProperty "s_cons_s" s_cons_s,
1055− testProperty "sf_take" sf_take,
760+ testProperty "sf_cons" sf_cons,
1056− testProperty "t_take" t_take,
1057− testProperty "tl_take" tl_take,
1058− testProperty "s_drop" s_drop,
1059− testProperty "s_drop_s" s_drop_s,
1060− testProperty "sf_drop" sf_drop,
1061− testProperty "t_drop" t_drop,
1062− testProperty "tl_drop" tl_drop,
1063− testProperty "s_take_drop" s_take_drop,
761+ testProperty "t_cons" t_cons,
1064− testProperty "s_take_drop_s" s_take_drop_s,
762+ testProperty "tl_cons" tl_cons,
1065− testProperty "s_takeWhile" s_takeWhile,
763+ testProperty "s_snoc" s_snoc,
1066− testProperty "s_takeWhile_s" s_takeWhile_s,
764+ testProperty "t_snoc" t_snoc,
1067− testProperty "sf_takeWhile" sf_takeWhile,
765+ testProperty "tl_snoc" tl_snoc,
1068− testProperty "t_takeWhile" t_takeWhile,
766+ testProperty "s_append" s_append,
1069− testProperty "tl_takeWhile" tl_takeWhile,
767+ testProperty "s_append_s" s_append_s,
1070− testProperty "sf_dropWhile" sf_dropWhile,
768+ testProperty "sf_append" sf_append,
1071− testProperty "s_dropWhile" s_dropWhile,
769+ testProperty "t_append" t_append,
1072− testProperty "s_dropWhile_s" s_dropWhile_s,
770+ testProperty "s_uncons" s_uncons,
1073− testProperty "t_dropWhile" t_dropWhile,
771+ testProperty "sf_uncons" sf_uncons,
1074− testProperty "tl_dropWhile" tl_dropWhile,
772+ testProperty "t_uncons" t_uncons,
1075− testProperty "t_dropWhileEnd" t_dropWhileEnd,
773+ testProperty "tl_uncons" tl_uncons,
1076− testProperty "tl_dropWhileEnd" tl_dropWhileEnd,
774+ testProperty "s_head" s_head,
1077− testProperty "t_dropAround" t_dropAround,
775+ testProperty "sf_head" sf_head,
1078− testProperty "tl_dropAround" tl_dropAround,
776+ testProperty "t_head" t_head,
1079− testProperty "t_stripStart" t_stripStart,
777+ testProperty "tl_head" tl_head,
1080− testProperty "tl_stripStart" tl_stripStart,
778+ testProperty "s_last" s_last,
1081− testProperty "t_stripEnd" t_stripEnd,
779+ testProperty "sf_last" sf_last,
1082− testProperty "tl_stripEnd" tl_stripEnd,
780+ testProperty "t_last" t_last,
1083− testProperty "t_strip" t_strip,
781+ testProperty "tl_last" tl_last,
1084− testProperty "tl_strip" tl_strip,
782+ testProperty "s_tail" s_tail,
1085− testProperty "t_splitAt" t_splitAt,
783+ testProperty "s_tail_s" s_tail_s,
1086− testProperty "tl_splitAt" tl_splitAt,
784+ testProperty "sf_tail" sf_tail,
1087− testProperty "t_span" t_span,
785+ testProperty "t_tail" t_tail,
1088− testProperty "tl_span" tl_span,
786+ testProperty "tl_tail" tl_tail,
1089− testProperty "t_breakOn_id" t_breakOn_id,
787+ testProperty "s_init" s_init,
1090− testProperty "tl_breakOn_id" tl_breakOn_id,
788+ testProperty "s_init_s" s_init_s,
1091− testProperty "t_breakOn_start" t_breakOn_start,
789+ testProperty "sf_init" sf_init,
1092− testProperty "tl_breakOn_start" tl_breakOn_start,
790+ testProperty "t_init" t_init,
1093− testProperty "t_breakOnEnd_end" t_breakOnEnd_end,
791+ testProperty "tl_init" tl_init,
1094− testProperty "tl_breakOnEnd_end" tl_breakOnEnd_end,
792+ testProperty "s_null" s_null,
1095− testProperty "t_break" t_break,
793+ testProperty "sf_null" sf_null,
1096− testProperty "tl_break" tl_break,
794+ testProperty "t_null" t_null,
1097− testProperty "t_group" t_group,
795+ testProperty "tl_null" tl_null,
1098− testProperty "tl_group" tl_group,
796+ testProperty "s_length" s_length,
1099− testProperty "t_groupBy" t_groupBy,
797+ testProperty "sf_length" sf_length,
1100− testProperty "tl_groupBy" tl_groupBy,
798+ testProperty "sl_length" sl_length,
1101− testProperty "t_inits" t_inits,
799+ testProperty "t_length" t_length,
1102− testProperty "tl_inits" tl_inits,
800+ testProperty "tl_length" tl_length,
1103− testProperty "t_tails" t_tails,
801+ testProperty "t_compareLength" t_compareLength,
1104− testProperty "tl_tails" tl_tails
802+ testProperty "tl_compareLength" tl_compareLength
1105 ],
803 ],
1106
804
1107− testGroup "breaking many" [
805+ testGroup "transformations" [
1108− testProperty "t_findAppendId" t_findAppendId,
806+ testProperty "s_map" s_map,
1109− testProperty "tl_findAppendId" tl_findAppendId,
807+ testProperty "s_map_s" s_map_s,
1110− testProperty "t_findContains" t_findContains,
808+ testProperty "sf_map" sf_map,
1111− testProperty "tl_findContains" tl_findContains,
809+ testProperty "t_map" t_map,
1112− testProperty "sl_filterCount" sl_filterCount,
810+ testProperty "tl_map" tl_map,
1113− testProperty "t_findCount" t_findCount,
811+ testProperty "s_intercalate" s_intercalate,
1114− testProperty "tl_findCount" tl_findCount,
812+ testProperty "t_intercalate" t_intercalate,
1115− testProperty "t_splitOn_split" t_splitOn_split,
813+ testProperty "tl_intercalate" tl_intercalate,
1116− testProperty "tl_splitOn_split" tl_splitOn_split,
814+ testProperty "s_intersperse" s_intersperse,
1117− testProperty "t_splitOn_i" t_splitOn_i,
815+ testProperty "s_intersperse_s" s_intersperse_s,
1118− testProperty "tl_splitOn_i" tl_splitOn_i,
816+ testProperty "sf_intersperse" sf_intersperse,
1119− testProperty "t_split" t_split,
817+ testProperty "t_intersperse" t_intersperse,
1120− testProperty "t_split_count" t_split_count,
818+ testProperty "tl_intersperse" tl_intersperse,
1121− testProperty "t_split_splitOn" t_split_splitOn,
819+ testProperty "t_transpose" t_transpose,
1122− testProperty "tl_split" tl_split,
820+ testProperty "tl_transpose" tl_transpose,
1123− testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,
821+ testProperty "t_reverse" t_reverse,
1124− testProperty "t_chunksOf_length" t_chunksOf_length,
822+ testProperty "tl_reverse" tl_reverse,
1125− testProperty "tl_chunksOf" tl_chunksOf
823+ testProperty "t_reverse_short" t_reverse_short,
824+ testProperty "t_replace" t_replace,
825+ testProperty "tl_replace" tl_replace,
826+
827+ testGroup "case conversion" [
828+ testProperty "s_toCaseFold_length" s_toCaseFold_length,
829+ testProperty "sf_toCaseFold_length" sf_toCaseFold_length,
830+ testProperty "t_toCaseFold_length" t_toCaseFold_length,
831+ testProperty "tl_toCaseFold_length" tl_toCaseFold_length,
832+ testProperty "t_toLower_length" t_toLower_length,
833+ testProperty "t_toLower_lower" t_toLower_lower,
834+ testProperty "tl_toLower_lower" tl_toLower_lower,
835+ testProperty "t_toUpper_length" t_toUpper_length,
836+ testProperty "t_toUpper_upper" t_toUpper_upper,
837+ testProperty "tl_toUpper_upper" tl_toUpper_upper
838+ ],
839+
840+ testGroup "justification" [
841+ testProperty "s_justifyLeft" s_justifyLeft,
842+ testProperty "s_justifyLeft_s" s_justifyLeft_s,
843+ testProperty "sf_justifyLeft" sf_justifyLeft,
844+ testProperty "t_justifyLeft" t_justifyLeft,
845+ testProperty "tl_justifyLeft" tl_justifyLeft,
846+ testProperty "t_justifyRight" t_justifyRight,
847+ testProperty "tl_justifyRight" tl_justifyRight,
848+ testProperty "t_center" t_center,
849+ testProperty "tl_center" tl_center
850+ ]
1126 ],
851 ],
1127
852
853+ testGroup "folds" [
854+ testProperty "sf_foldl" sf_foldl,
855+ testProperty "t_foldl" t_foldl,
856+ testProperty "tl_foldl" tl_foldl,
857+ testProperty "sf_foldl'" sf_foldl',
858+ testProperty "t_foldl'" t_foldl',
859+ testProperty "tl_foldl'" tl_foldl',
860+ testProperty "sf_foldl1" sf_foldl1,
861+ testProperty "t_foldl1" t_foldl1,
862+ testProperty "tl_foldl1" tl_foldl1,
863+ testProperty "t_foldl1'" t_foldl1',
864+ testProperty "sf_foldl1'" sf_foldl1',
865+ testProperty "tl_foldl1'" tl_foldl1',
866+ testProperty "sf_foldr" sf_foldr,
867+ testProperty "t_foldr" t_foldr,
868+ testProperty "tl_foldr" tl_foldr,
869+ testProperty "sf_foldr1" sf_foldr1,
870+ testProperty "t_foldr1" t_foldr1,
871+ testProperty "tl_foldr1" tl_foldr1,
872+
873+ testGroup "special" [
874+ testProperty "s_concat_s" s_concat_s,
875+ testProperty "sf_concat" sf_concat,
876+ testProperty "t_concat" t_concat,
877+ testProperty "tl_concat" tl_concat,
878+ testProperty "sf_concatMap" sf_concatMap,
879+ testProperty "t_concatMap" t_concatMap,
880+ testProperty "tl_concatMap" tl_concatMap,
881+ testProperty "sf_any" sf_any,
882+ testProperty "t_any" t_any,
883+ testProperty "tl_any" tl_any,
884+ testProperty "sf_all" sf_all,
885+ testProperty "t_all" t_all,
886+ testProperty "tl_all" tl_all,
887+ testProperty "sf_maximum" sf_maximum,
888+ testProperty "t_maximum" t_maximum,
889+ testProperty "tl_maximum" tl_maximum,
890+ testProperty "sf_minimum" sf_minimum,
891+ testProperty "t_minimum" t_minimum,
892+ testProperty "tl_minimum" tl_minimum
893+ ]
894+ ],
895+
896+ testGroup "construction" [
897+ testGroup "scans" [
898+ testProperty "sf_scanl" sf_scanl,
899+ testProperty "t_scanl" t_scanl,
900+ testProperty "tl_scanl" tl_scanl,
901+ testProperty "t_scanl1" t_scanl1,
902+ testProperty "tl_scanl1" tl_scanl1,
903+ testProperty "t_scanr" t_scanr,
904+ testProperty "tl_scanr" tl_scanr,
905+ testProperty "t_scanr1" t_scanr1,
906+ testProperty "tl_scanr1" tl_scanr1
907+ ],
908+
909+ testGroup "mapAccum" [
910+ testProperty "t_mapAccumL" t_mapAccumL,
911+ testProperty "tl_mapAccumL" tl_mapAccumL,
912+ testProperty "t_mapAccumR" t_mapAccumR,
913+ testProperty "tl_mapAccumR" tl_mapAccumR
914+ ],
915+
916+ testGroup "unfolds" [
917+ testProperty "s_replicate" s_replicate,
918+ testProperty "t_replicate" t_replicate,
919+ testProperty "tl_replicate" tl_replicate,
920+ testProperty "t_unfoldr" t_unfoldr,
921+ testProperty "tl_unfoldr" tl_unfoldr,
922+ testProperty "t_unfoldrN" t_unfoldrN,
923+ testProperty "tl_unfoldrN" tl_unfoldrN
924+ ]
925+ ],
926+
927+ testGroup "substrings" [
928+ testGroup "breaking" [
929+ testProperty "s_take" s_take,
930+ testProperty "s_take_s" s_take_s,
931+ testProperty "sf_take" sf_take,
932+ testProperty "t_take" t_take,
933+ testProperty "tl_take" tl_take,
934+ testProperty "s_drop" s_drop,
935+ testProperty "s_drop_s" s_drop_s,
936+ testProperty "sf_drop" sf_drop,
937+ testProperty "t_drop" t_drop,
938+ testProperty "tl_drop" tl_drop,
939+ testProperty "s_take_drop" s_take_drop,
940+ testProperty "s_take_drop_s" s_take_drop_s,
941+ testProperty "s_takeWhile" s_takeWhile,
942+ testProperty "s_takeWhile_s" s_takeWhile_s,
943+ testProperty "sf_takeWhile" sf_takeWhile,
944+ testProperty "t_takeWhile" t_takeWhile,
945+ testProperty "tl_takeWhile" tl_takeWhile,
946+ testProperty "sf_dropWhile" sf_dropWhile,
947+ testProperty "s_dropWhile" s_dropWhile,
948+ testProperty "s_dropWhile_s" s_dropWhile_s,
949+ testProperty "t_dropWhile" t_dropWhile,
950+ testProperty "tl_dropWhile" tl_dropWhile,
951+ testProperty "t_dropWhileEnd" t_dropWhileEnd,
952+ testProperty "tl_dropWhileEnd" tl_dropWhileEnd,
953+ testProperty "t_dropAround" t_dropAround,
954+ testProperty "tl_dropAround" tl_dropAround,
955+ testProperty "t_stripStart" t_stripStart,
956+ testProperty "tl_stripStart" tl_stripStart,
957+ testProperty "t_stripEnd" t_stripEnd,
958+ testProperty "tl_stripEnd" tl_stripEnd,
959+ testProperty "t_strip" t_strip,
960+ testProperty "tl_strip" tl_strip,
961+ testProperty "t_splitAt" t_splitAt,
962+ testProperty "tl_splitAt" tl_splitAt,
963+ testProperty "t_span" t_span,
964+ testProperty "tl_span" tl_span,
965+ testProperty "t_breakOn_id" t_breakOn_id,
966+ testProperty "tl_breakOn_id" tl_breakOn_id,
967+ testProperty "t_breakOn_start" t_breakOn_start,
968+ testProperty "tl_breakOn_start" tl_breakOn_start,
969+ testProperty "t_breakOnEnd_end" t_breakOnEnd_end,
970+ testProperty "tl_breakOnEnd_end" tl_breakOnEnd_end,
971+ testProperty "t_break" t_break,
972+ testProperty "tl_break" tl_break,
973+ testProperty "t_group" t_group,
974+ testProperty "tl_group" tl_group,
975+ testProperty "t_groupBy" t_groupBy,
976+ testProperty "tl_groupBy" tl_groupBy,
977+ testProperty "t_inits" t_inits,
978+ testProperty "tl_inits" tl_inits,
979+ testProperty "t_tails" t_tails,
980+ testProperty "tl_tails" tl_tails
981+ ],
982+
983+ testGroup "breaking many" [
984+ testProperty "t_findAppendId" t_findAppendId,
985+ testProperty "tl_findAppendId" tl_findAppendId,
986+ testProperty "t_findContains" t_findContains,
987+ testProperty "tl_findContains" tl_findContains,
988+ testProperty "sl_filterCount" sl_filterCount,
989+ testProperty "t_findCount" t_findCount,
990+ testProperty "tl_findCount" tl_findCount,
991+ testProperty "t_splitOn_split" t_splitOn_split,
992+ testProperty "tl_splitOn_split" tl_splitOn_split,
993+ testProperty "t_splitOn_i" t_splitOn_i,
994+ testProperty "tl_splitOn_i" tl_splitOn_i,
995+ testProperty "t_split" t_split,
996+ testProperty "t_split_count" t_split_count,
997+ testProperty "t_split_splitOn" t_split_splitOn,
998+ testProperty "tl_split" tl_split,
999+ testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,
1000+ testProperty "t_chunksOf_length" t_chunksOf_length,
1001+ testProperty "tl_chunksOf" tl_chunksOf
1002+ ],
1003+
1128− testGroup "lines and words" [
1004+ testGroup "lines and words" [
1129− testProperty "t_lines" t_lines,
1005+ testProperty "t_lines" t_lines,
1130− testProperty "tl_lines" tl_lines,
1006+ testProperty "tl_lines" tl_lines,
1131− --testProperty "t_lines'" t_lines',
1007+ --testProperty "t_lines'" t_lines',
1132− testProperty "t_words" t_words,
1008+ testProperty "t_words" t_words,
1133− testProperty "tl_words" tl_words,
1009+ testProperty "tl_words" tl_words,
1134− testProperty "t_unlines" t_unlines,
1010+ testProperty "t_unlines" t_unlines,
1135− testProperty "tl_unlines" tl_unlines,
1011+ testProperty "tl_unlines" tl_unlines,
1136− testProperty "t_unwords" t_unwords,
1012+ testProperty "t_unwords" t_unwords,
1137− testProperty "tl_unwords" tl_unwords
1013+ testProperty "tl_unwords" tl_unwords
1138− ]
1014+ ]
1139− ],
1015+ ],
1140−
1016+
1141− testGroup "predicates" [
1017+ testGroup "predicates" [
1142− testProperty "s_isPrefixOf" s_isPrefixOf,
1018+ testProperty "s_isPrefixOf" s_isPrefixOf,
1143− testProperty "sf_isPrefixOf" sf_isPrefixOf,
1019+ testProperty "sf_isPrefixOf" sf_isPrefixOf,
1144− testProperty "t_isPrefixOf" t_isPrefixOf,
1020+ testProperty "t_isPrefixOf" t_isPrefixOf,
1145− testProperty "tl_isPrefixOf" tl_isPrefixOf,
1021+ testProperty "tl_isPrefixOf" tl_isPrefixOf,
1146− testProperty "t_isSuffixOf" t_isSuffixOf,
1022+ testProperty "t_isSuffixOf" t_isSuffixOf,
1147− testProperty "tl_isSuffixOf" tl_isSuffixOf,
1023+ testProperty "tl_isSuffixOf" tl_isSuffixOf,
1148− testProperty "t_isInfixOf" t_isInfixOf,
1024+ testProperty "t_isInfixOf" t_isInfixOf,
1149− testProperty "tl_isInfixOf" tl_isInfixOf,
1025+ testProperty "tl_isInfixOf" tl_isInfixOf,
1150−
1026+
1151− testGroup "view" [
1027+ testGroup "view" [
1152− testProperty "t_stripPrefix" t_stripPrefix,
1028+ testProperty "t_stripPrefix" t_stripPrefix,
1153− testProperty "tl_stripPrefix" tl_stripPrefix,
1029+ testProperty "tl_stripPrefix" tl_stripPrefix,
1154− testProperty "t_stripSuffix" t_stripSuffix,
1030+ testProperty "t_stripSuffix" t_stripSuffix,
1155− testProperty "tl_stripSuffix" tl_stripSuffix,
1031+ testProperty "tl_stripSuffix" tl_stripSuffix,
1156− testProperty "t_commonPrefixes" t_commonPrefixes,
1032+ testProperty "t_commonPrefixes" t_commonPrefixes,
1157− testProperty "tl_commonPrefixes" tl_commonPrefixes
1033+ testProperty "tl_commonPrefixes" tl_commonPrefixes
1034+ ]
1035+ ],
1036+
1037+ testGroup "searching" [
1038+ testProperty "sf_elem" sf_elem,
1039+ testProperty "sf_filter" sf_filter,
1040+ testProperty "t_filter" t_filter,
1041+ testProperty "tl_filter" tl_filter,
1042+ testProperty "sf_findBy" sf_findBy,
1043+ testProperty "t_find" t_find,
1044+ testProperty "tl_find" tl_find,
1045+ testProperty "t_partition" t_partition,
1046+ testProperty "tl_partition" tl_partition
1047+ ],
1048+
1049+ testGroup "indexing" [
1050+ testProperty "sf_index" sf_index,
1051+ testProperty "t_index" t_index,
1052+ testProperty "tl_index" tl_index,
1053+ testProperty "t_findIndex" t_findIndex,
1054+ testProperty "t_count" t_count,
1055+ testProperty "tl_count" tl_count,
1056+ testProperty "t_indices" t_indices,
1057+ testProperty "tl_indices" tl_indices,
1058+ testProperty "t_indices_occurs" t_indices_occurs
1059+ ],
1060+
1061+ testGroup "zips" [
1062+ testProperty "t_zip" t_zip,
1063+ testProperty "tl_zip" tl_zip,
1064+ testProperty "sf_zipWith" sf_zipWith,
1065+ testProperty "t_zipWith" t_zipWith,
1066+ testProperty "tl_zipWith" tl_zipWith
1067+ ],
1068+
1069+ testGroup "regressions" [
1070+ testProperty "s_filter_eq" s_filter_eq
1071+ ],
1072+
1073+ testGroup "shifts" [
1074+ testProperty "shiftL_Int" shiftL_Int,
1075+ testProperty "shiftL_Word16" shiftL_Word16,
1076+ testProperty "shiftL_Word32" shiftL_Word32,
1077+ testProperty "shiftR_Int" shiftR_Int,
1078+ testProperty "shiftR_Word16" shiftR_Word16,
1079+ testProperty "shiftR_Word32" shiftR_Word32
1080+ ],
1081+
1082+ testGroup "builder" [
1083+ testProperty "t_builderSingleton" t_builderSingleton,
1084+ testProperty "t_builderFromText" t_builderFromText,
1085+ testProperty "t_builderAssociative" t_builderAssociative
1086+ ],
1087+
1088+ testGroup "read" [
1089+ testProperty "t_decimal" t_decimal,
1090+ testProperty "tl_decimal" tl_decimal,
1091+ testProperty "t_hexadecimal" t_hexadecimal,
1092+ testProperty "tl_hexadecimal" tl_hexadecimal,
1093+ testProperty "t_double" t_double,
1094+ testProperty "tl_double" tl_double,
1095+ testProperty "t_rational" t_rational,
1096+ testProperty "tl_rational" tl_rational
1097+ ],
1098+
1099+ testGroup "input-output" [
1100+ testProperty "t_write_read" t_write_read,
1101+ testProperty "tl_write_read" tl_write_read,
1102+ testProperty "t_write_read_line" t_write_read_line,
1103+ testProperty "tl_write_read_line" tl_write_read_line
1104+ -- These tests are subject to I/O race conditions when run under
1105+ -- test-framework-quickcheck2.
1106+ -- testProperty "t_put_get" t_put_get
1107+ -- testProperty "tl_put_get" tl_put_get
1108+ ],
1109+
1110+ testGroup "lowlevel" [
1111+ testProperty "t_dropWord16" t_dropWord16,
1112+ testProperty "t_takeWord16" t_takeWord16,
1113+ testProperty "t_take_drop_16" t_take_drop_16,
1114+ testProperty "t_use_from" t_use_from
1158 ]
1115 ]
1159− ],
1160−
1161− testGroup "searching" [
1162− testProperty "sf_elem" sf_elem,
1163− testProperty "sf_filter" sf_filter,
1164− testProperty "t_filter" t_filter,
1165− testProperty "tl_filter" tl_filter,
1166− testProperty "sf_findBy" sf_findBy,
1167− testProperty "t_find" t_find,
1168− testProperty "tl_find" tl_find,
1169− testProperty "t_partition" t_partition,
1170− testProperty "tl_partition" tl_partition
1171− ],
1172−
1173− testGroup "indexing" [
1174− testProperty "sf_index" sf_index,
1175− testProperty "t_index" t_index,
1176− testProperty "tl_index" tl_index,
1177− testProperty "t_findIndex" t_findIndex,
1178− testProperty "t_count" t_count,
1179− testProperty "tl_count" tl_count,
1180− testProperty "t_indices" t_indices,
1181− testProperty "tl_indices" tl_indices,
1182− testProperty "t_indices_occurs" t_indices_occurs
1183− ],
1184−
1185− testGroup "zips" [
1186− testProperty "t_zip" t_zip,
1187− testProperty "tl_zip" tl_zip,
1188− testProperty "sf_zipWith" sf_zipWith,
1189− testProperty "t_zipWith" t_zipWith,
1190− testProperty "tl_zipWith" tl_zipWith
1191− ],
1192−
1193− testGroup "regressions" [
1194− testProperty "s_filter_eq" s_filter_eq
1195− ],
1196−
1197− testGroup "shifts" [
1198− testProperty "shiftL_Int" shiftL_Int,
1199− testProperty "shiftL_Word16" shiftL_Word16,
1200− testProperty "shiftL_Word32" shiftL_Word32,
1201− testProperty "shiftR_Int" shiftR_Int,
1202− testProperty "shiftR_Word16" shiftR_Word16,
1203− testProperty "shiftR_Word32" shiftR_Word32
1204− ],
1205−
1206− testGroup "builder" [
1207− testProperty "t_builderSingleton" t_builderSingleton,
1208− testProperty "t_builderFromText" t_builderFromText,
1209− testProperty "t_builderAssociative" t_builderAssociative
1210− ],
1211−
1212− testGroup "read" [
1213− testProperty "t_decimal" t_decimal,
1214− testProperty "tl_decimal" tl_decimal,
1215− testProperty "t_hexadecimal" t_hexadecimal,
1216− testProperty "tl_hexadecimal" tl_hexadecimal,
1217− testProperty "t_double" t_double,
1218− testProperty "tl_double" tl_double,
1219− testProperty "t_rational" t_rational,
1220− testProperty "tl_rational" tl_rational
1221− ],
1222−
1223− testGroup "input-output" [
1224− testProperty "t_write_read" t_write_read,
1225− testProperty "tl_write_read" tl_write_read,
1226− testProperty "t_write_read_line" t_write_read_line,
1227− testProperty "tl_write_read_line" tl_write_read_line
1228− -- These tests are subject to I/O race conditions when run under
1229− -- test-framework-quickcheck2.
1230− -- testProperty "t_put_get" t_put_get
1231− -- testProperty "tl_put_get" tl_put_get
1232− ],
1233−
1234− testGroup "lowlevel" [
1235− testProperty "t_dropWord16" t_dropWord16,
1236− testProperty "t_takeWord16" t_takeWord16,
1237− testProperty "t_take_drop_16" t_take_drop_16,
1238− testProperty "t_use_from" t_use_from
1239 ]
1116 ]
1240− ]
tests/tests/src/Data/Text/Tests/QuickCheckUtils.hsnew file+337
@@ -0,0 +1,337 @@
1+-- | This module provides quickcheck utilities, e.g. arbitrary and show
2+-- instances, and comparison functions, so we can focus on the actual properties
3+-- in the 'Data.Text.Tests.Properties' module.
4+--
5+{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
6+{-# OPTIONS_GHC -fno-warn-orphans #-}
7+module Data.Text.Tests.QuickCheckUtils
8+ (
9+ genUnicode
10+ , unsquare
11+ , smallArbitrary
12+
13+ , NotEmpty (..)
14+
15+ , Small (..)
16+ , small
17+
18+ , integralRandomR
19+
20+ , DecodeErr (..)
21+
22+ , Stringy (..)
23+ , eq
24+ , eqP
25+
26+ , Encoding (..)
27+
28+ , write_read
29+ ) where
30+
31+import Control.Arrow (first, (***))
32+import Control.DeepSeq (NFData (..), deepseq)
33+import Control.Exception (bracket)
34+import Data.Bits ((.&.))
35+import Data.Char (chr)
36+import Data.Word (Word8, Word16)
37+import Data.String (IsString, fromString)
38+import Data.Text.Foreign (I16)
39+import Debug.Trace (trace)
40+import System.Random (Random (..), RandomGen)
41+import Test.QuickCheck hiding ((.&.))
42+import Test.QuickCheck.Monadic (assert, monadicIO, run)
43+import qualified Data.ByteString as B
44+import qualified Data.Text as T
45+import qualified Data.Text.Encoding.Error as T
46+import qualified Data.Text.Fusion as TF
47+import qualified Data.Text.Fusion.Common as TF
48+import qualified Data.Text.Lazy as TL
49+import qualified Data.Text.Lazy.Fusion as TLF
50+import qualified Data.Text.Lazy.Internal as TL
51+import qualified System.IO as IO
52+
53+import Data.Text.Tests.Utils
54+
55+instance Random I16 where
56+ randomR = integralRandomR
57+ random = randomR (minBound,maxBound)
58+
59+instance Arbitrary I16 where
60+ arbitrary = choose (minBound,maxBound)
61+
62+instance Arbitrary B.ByteString where
63+ arbitrary = B.pack `fmap` arbitrary
64+
65+genUnicode :: IsString a => Gen a
66+genUnicode = fmap fromString string where
67+ string = sized $ \n ->
68+ do k <- choose (0,n)
69+ sequence [ char | _ <- [1..k] ]
70+
71+ excluding :: [a -> Bool] -> Gen a -> Gen a
72+ excluding bad gen = loop
73+ where
74+ loop = do
75+ x <- gen
76+ if or (map ($ x) bad)
77+ then loop
78+ else return x
79+
80+ reserved = [lowSurrogate, highSurrogate, noncharacter]
81+ lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
82+ highSurrogate c = c >= 0xD800 && c <= 0xDBFF
83+ noncharacter c = masked == 0xFFFE || masked == 0xFFFF
84+ where
85+ masked = c .&. 0xFFFF
86+
87+ ascii = choose (0,0x7F)
88+ plane0 = choose (0xF0, 0xFFFF)
89+ plane1 = oneof [ choose (0x10000, 0x10FFF)
90+ , choose (0x11000, 0x11FFF)
91+ , choose (0x12000, 0x12FFF)
92+ , choose (0x13000, 0x13FFF)
93+ , choose (0x1D000, 0x1DFFF)
94+ , choose (0x1F000, 0x1FFFF)
95+ ]
96+ plane2 = oneof [ choose (0x20000, 0x20FFF)
97+ , choose (0x21000, 0x21FFF)
98+ , choose (0x22000, 0x22FFF)
99+ , choose (0x23000, 0x23FFF)
100+ , choose (0x24000, 0x24FFF)
101+ , choose (0x25000, 0x25FFF)
102+ , choose (0x26000, 0x26FFF)
103+ , choose (0x27000, 0x27FFF)
104+ , choose (0x28000, 0x28FFF)
105+ , choose (0x29000, 0x29FFF)
106+ , choose (0x2A000, 0x2AFFF)
107+ , choose (0x2B000, 0x2BFFF)
108+ , choose (0x2F000, 0x2FFFF)
109+ ]
110+ plane14 = choose (0xE0000, 0xE0FFF)
111+ planes = [ascii, plane0, plane1, plane2, plane14]
112+
113+ char = chr `fmap` excluding reserved (oneof planes)
114+
115+-- For tests that have O(n^2) running times or input sizes, resize
116+-- their inputs to the square root of the originals.
117+unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property
118+unsquare = forAll smallArbitrary
119+
120+smallArbitrary :: (Arbitrary a, Show a) => Gen a
121+smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
122+ where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
123+
124+instance Arbitrary T.Text where
125+ arbitrary = T.pack `fmap` arbitrary
126+
127+instance Arbitrary TL.Text where
128+ arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
129+
130+newtype NotEmpty a = NotEmpty { notEmpty :: a }
131+ deriving (Eq, Ord)
132+
133+instance Show a => Show (NotEmpty a) where
134+ show (NotEmpty a) = show a
135+
136+instance Functor NotEmpty where
137+ fmap f (NotEmpty a) = NotEmpty (f a)
138+
139+instance Arbitrary a => Arbitrary (NotEmpty [a]) where
140+ arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
141+
142+instance Arbitrary (NotEmpty T.Text) where
143+ arbitrary = (fmap T.pack) `fmap` arbitrary
144+
145+instance Arbitrary (NotEmpty TL.Text) where
146+ arbitrary = (fmap TL.pack) `fmap` arbitrary
147+
148+instance Arbitrary (NotEmpty B.ByteString) where
149+ arbitrary = (fmap B.pack) `fmap` arbitrary
150+
151+data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
152+ | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
153+ | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23
154+ | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31
155+ deriving (Eq, Ord, Enum, Bounded)
156+
157+small :: Integral a => Small -> a
158+small = fromIntegral . fromEnum
159+
160+intf :: (Int -> Int -> Int) -> Small -> Small -> Small
161+intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)
162+
163+instance Show Small where
164+ show = show . fromEnum
165+
166+instance Read Small where
167+ readsPrec n = map (first toEnum) . readsPrec n
168+
169+instance Num Small where
170+ fromInteger = toEnum . fromIntegral
171+ signum _ = 1
172+ abs = id
173+ (+) = intf (+)
174+ (-) = intf (-)
175+ (*) = intf (*)
176+
177+instance Real Small where
178+ toRational = toRational . fromEnum
179+
180+instance Integral Small where
181+ toInteger = toInteger . fromEnum
182+ quotRem a b = (toEnum x, toEnum y)
183+ where (x, y) = fromEnum a `quotRem` fromEnum b
184+
185+instance Random Small where
186+ randomR = integralRandomR
187+ random = randomR (minBound,maxBound)
188+
189+instance Arbitrary Small where
190+ arbitrary = choose (minBound,maxBound)
191+
192+integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
193+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
194+ fromIntegral b :: Integer) g of
195+ (x,h) -> (fromIntegral x, h)
196+
197+data DecodeErr = DE String T.OnDecodeError
198+
199+instance Show DecodeErr where
200+ show (DE d _) = "DE " ++ d
201+
202+instance Arbitrary DecodeErr where
203+ arbitrary = oneof [ return $ DE "lenient" T.lenientDecode
204+ , return $ DE "ignore" T.ignore
205+ , return $ DE "strict" T.strictDecode
206+ , DE "replace" `fmap` arbitrary ]
207+
208+class Stringy s where
209+ packS :: String -> s
210+ unpackS :: s -> String
211+ splitAtS :: Int -> s -> (s,s)
212+ packSChunkSize :: Int -> String -> s
213+ packSChunkSize _ = packS
214+
215+instance Stringy String where
216+ packS = id
217+ unpackS = id
218+ splitAtS = splitAt
219+
220+instance Stringy (TF.Stream Char) where
221+ packS = TF.streamList
222+ unpackS = TF.unstreamList
223+ splitAtS n s = (TF.take n s, TF.drop n s)
224+
225+instance Stringy T.Text where
226+ packS = T.pack
227+ unpackS = T.unpack
228+ splitAtS = T.splitAt
229+
230+instance Stringy TL.Text where
231+ packSChunkSize k = TLF.unstreamChunks k . TF.streamList
232+ packS = TL.pack
233+ unpackS = TL.unpack
234+ splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .
235+ TL.splitAt . fromIntegral
236+
237+-- Do two functions give the same answer?
238+eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
239+eq a b s = a s =^= b s
240+
241+-- What about with the RHS packed?
242+eqP :: (Eq a, Show a, Stringy s) =>
243+ (String -> a) -> (s -> a) -> String -> Word8 -> Bool
244+eqP f g s w = eql "orig" (f s) (g t) &&
245+ eql "mini" (f s) (g mini) &&
246+ eql "head" (f sa) (g ta) &&
247+ eql "tail" (f sb) (g tb)
248+ where t = packS s
249+ mini = packSChunkSize 10 s
250+ (sa,sb) = splitAt m s
251+ (ta,tb) = splitAtS m t
252+ l = length s
253+ m | l == 0 = n
254+ | otherwise = n `mod` l
255+ n = fromIntegral w
256+ eql d a b
257+ | a =^= b = True
258+ | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
259+
260+-- Work around lack of Show instance for TextEncoding.
261+data Encoding = E String IO.TextEncoding
262+
263+instance Show Encoding where show (E n _) = "utf" ++ n
264+
265+instance Arbitrary Encoding where
266+ arbitrary = oneof . map return $
267+ [ E "8" IO.utf8, E "8_bom" IO.utf8_bom, E "16" IO.utf16
268+ , E "16le" IO.utf16le, E "16be" IO.utf16be, E "32" IO.utf32
269+ , E "32le" IO.utf32le, E "32be" IO.utf32be
270+ ]
271+
272+windowsNewlineMode :: IO.NewlineMode
273+windowsNewlineMode = IO.NewlineMode
274+ { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
275+ }
276+
277+-- Newline and NewlineMode have standard Show instance from GHC 7 onwards
278+#if __GLASGOW_HASKELL__ < 700
279+instance Show Newline where
280+ show CRLF = "CRLF"
281+ show LF = "LF"
282+
283+instance Show NewlineMode where
284+ show (NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++
285+ ", outputNL = " ++ show o ++ " }"
286+# endif
287+
288+instance Arbitrary IO.NewlineMode where
289+ arbitrary = oneof . map return $
290+ [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
291+ , windowsNewlineMode
292+ ]
293+
294+instance Arbitrary IO.BufferMode where
295+ arbitrary = oneof [ return IO.NoBuffering,
296+ return IO.LineBuffering,
297+ return (IO.BlockBuffering Nothing),
298+ (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap`
299+ (arbitrary :: Gen Word16) ]
300+
301+-- This test harness is complex! What property are we checking?
302+--
303+-- Reading after writing a multi-line file should give the same
304+-- results as were written.
305+--
306+-- What do we vary while checking this property?
307+-- * The lines themselves, scrubbed to contain neither CR nor LF. (By
308+-- working with a list of lines, we ensure that the data will
309+-- sometimes contain line endings.)
310+-- * Encoding.
311+-- * Newline translation mode.
312+-- * Buffering.
313+write_read :: (NFData a, Eq a)
314+ => ([b] -> a)
315+ -> ((Char -> Bool) -> a -> b)
316+ -> (IO.Handle -> a -> IO ())
317+ -> (IO.Handle -> IO a)
318+ -> Encoding
319+ -> IO.NewlineMode
320+ -> IO.BufferMode
321+ -> [a]
322+ -> Property
323+write_read unline filt writer reader (E _ enc) nl buf ts =
324+ monadicIO $ assert . (==t) =<< run act
325+ where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
326+ act = withTempFile $ \path h -> do
327+ -- hSetEncoding h enc
328+ IO.hSetNewlineMode h nl
329+ IO.hSetBuffering h buf
330+ () <- writer h t
331+ IO.hClose h
332+ bracket (IO.openFile path IO.ReadMode) IO.hClose $ \h' -> do
333+ -- hSetEncoding h' enc
334+ IO.hSetNewlineMode h' nl
335+ IO.hSetBuffering h' buf
336+ r <- reader h'
337+ r `deepseq` return r
tests/Regressions.hs → tests/tests/src/Data/Text/Tests/Regressions.hsrenamed+17−11
@@ -1,9 +1,14 @@
1+-- | Regression tests for specific bugs.
2+--
1{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
3{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
2−
4+module Data.Text.Tests.Regressions
3−-- Regression tests for specific bugs.
5+ (
6+ tests
7+ ) where
4
8
5import Control.Exception (SomeException, handle)
9import Control.Exception (SomeException, handle)
6import System.IO
10import System.IO
11+import Test.HUnit (assertFailure)
7import qualified Data.ByteString as B
12import qualified Data.ByteString as B
8import qualified Data.ByteString.Lazy as LB
13import qualified Data.ByteString.Lazy as LB
9import qualified Data.Text as T
14import qualified Data.Text as T
@@ -12,18 +17,20 @@ import qualified Data.Text.Lazy as LT
12import qualified Data.Text.Lazy.Encoding as LE
17import qualified Data.Text.Lazy.Encoding as LE
13import qualified Test.Framework as F
18import qualified Test.Framework as F
14import qualified Test.Framework.Providers.HUnit as F
19import qualified Test.Framework.Providers.HUnit as F
15−import Test.HUnit (assertFailure)
20+
16−import TestUtils (withTempFile)
21+import Data.Text.Tests.Utils (withTempFile)
17
22
18-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
23-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
19-- caused either a segfault or attempt to allocate a negative number
24-- caused either a segfault or attempt to allocate a negative number
20-- of bytes.
25-- of bytes.
26+lazy_encode_crash :: IO ()
21lazy_encode_crash = withTempFile $ \ _ h ->
27lazy_encode_crash = withTempFile $ \ _ h ->
22 LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
28 LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
23
29
24-- Reported by Pieter Laeremans: attempting to read an incorrectly
30-- Reported by Pieter Laeremans: attempting to read an incorrectly
25-- encoded file can result in a crash in the RTS (i.e. not merely an
31-- encoded file can result in a crash in the RTS (i.e. not merely an
26-- exception).
32-- exception).
33+hGetContents_crash :: IO ()
27hGetContents_crash = withTempFile $ \ path h -> do
34hGetContents_crash = withTempFile $ \ path h -> do
28 B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h
35 B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h
29 h' <- openFile path ReadMode
36 h' <- openFile path ReadMode
@@ -34,6 +41,7 @@ hGetContents_crash = withTempFile $ \ path h -> do
34-- Reported by Ian Lynagh: attempting to allocate a sufficiently large
41-- Reported by Ian Lynagh: attempting to allocate a sufficiently large
35-- string (via either Array.new or Text.replicate) could result in an
42-- string (via either Array.new or Text.replicate) could result in an
36-- integer overflow.
43-- integer overflow.
44+replicate_crash :: IO ()
37replicate_crash = handle (\(_::SomeException) -> return ()) $
45replicate_crash = handle (\(_::SomeException) -> return ()) $
38 T.replicate (2^power) "0123456789abcdef" `seq`
46 T.replicate (2^power) "0123456789abcdef" `seq`
39 assertFailure "T.replicate should crash"
47 assertFailure "T.replicate should crash"
@@ -42,10 +50,8 @@ replicate_crash = handle (\(_::SomeException) -> return ()) $
42 | otherwise = 60 :: Int
50 | otherwise = 60 :: Int
43
51
44tests :: F.Test
52tests :: F.Test
45−tests = F.testGroup "crashers" [
53+tests = F.testGroup "Regressions"
46− F.testCase "hGetContents_crash" hGetContents_crash
54+ [ F.testCase "hGetContents_crash" hGetContents_crash
47− , F.testCase "lazy_encode_crash" lazy_encode_crash
55+ , F.testCase "lazy_encode_crash" lazy_encode_crash
48− , F.testCase "replicate_crash" replicate_crash
56+ , F.testCase "replicate_crash" replicate_crash
49− ]
57+ ]
50−
51−main = F.defaultMain [tests]
tests/SlowFunctions.hs → tests/tests/src/Data/Text/Tests/SlowFunctions.hsrenamed+1−2
@@ -1,6 +1,5 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2−
3−module SlowFunctions
2+module Data.Text.Tests.SlowFunctions
4 (
3 (
5 indices
4 indices
6 , splitOn
5 , splitOn
tests/tests/src/Data/Text/Tests/Utils.hsnew file+52
@@ -0,0 +1,52 @@
1+-- | Miscellaneous testing utilities
2+--
3+{-# LANGUAGE ScopedTypeVariables #-}
4+module Data.Text.Tests.Utils
5+ (
6+ (=^=)
7+ , withRedirect
8+ , withTempFile
9+ ) where
10+
11+import Control.Exception (SomeException, bracket, bracket_, evaluate, try)
12+import Control.Monad (when)
13+import Debug.Trace (trace)
14+import GHC.IO.Handle.Internals (withHandle)
15+import System.Directory (removeFile)
16+import System.IO (Handle, hClose, hFlush, hIsOpen, hIsWritable, openTempFile)
17+import System.IO.Unsafe (unsafePerformIO)
18+
19+-- Ensure that two potentially bottom values (in the sense of crashing
20+-- for some inputs, not looping infinitely) either both crash, or both
21+-- give comparable results for some input.
22+(=^=) :: (Eq a, Show a) => a -> a -> Bool
23+i =^= j = unsafePerformIO $ do
24+ x <- try (evaluate i)
25+ y <- try (evaluate j)
26+ case (x,y) of
27+ (Left (_ :: SomeException), Left (_ :: SomeException))
28+ -> return True
29+ (Right a, Right b) -> return (a == b)
30+ e -> trace ("*** Divergence: " ++ show e) return False
31+infix 4 =^=
32+{-# NOINLINE (=^=) #-}
33+
34+withTempFile :: (FilePath -> Handle -> IO a) -> IO a
35+withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
36+ where
37+ cleanupTemp (path,h) = do
38+ open <- hIsOpen h
39+ when open (hClose h)
40+ removeFile path
41+
42+withRedirect :: Handle -> Handle -> IO a -> IO a
43+withRedirect tmp h = bracket_ swap swap
44+ where
45+ whenM p a = p >>= (`when` a)
46+ swap = do
47+ whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp
48+ whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h
49+ withHandle "spam" tmp $ \tmph -> do
50+ hh <- withHandle "spam" h $ \hh ->
51+ return (tmph,hh)
52+ return (hh,())
tests/tests/text-tests.cabalnew file+125
@@ -0,0 +1,125 @@
1+name: text-tests
2+version: 0.0.0.0
3+synopsis: Functional tests for the text package
4+description: Functional tests for the text package
5+homepage: https://bitbucket.org/bos/text
6+license: BSD3
7+license-file: ../../LICENSE
8+author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
9+ Bryan O'Sullivan <bos@serpentine.com>,
10+ Tom Harper <rtomharper@googlemail.com>,
11+ Duncan Coutts <duncan@haskell.org>
12+maintainer: Bryan O'Sullivan <bos@serpentine.com>
13+category: Text
14+build-type: Simple
15+
16+cabal-version: >=1.8
17+
18+flag hpc
19+ description: Enable HPC to generate coverage reports
20+ default: False
21+
22+executable text-tests
23+ hs-source-dirs: src
24+ main-is: Data/Text/Tests.hs
25+
26+ ghc-options:
27+ -Wall
28+ -threaded
29+ -O0
30+
31+ if flag(hpc)
32+ ghc-options:
33+ -fhpc
34+
35+ cpp-options:
36+ -DASSERTS
37+ -DHAVE_DEEPSEQ
38+
39+ build-depends:
40+ text-tests,
41+ base >= 4 && < 5,
42+ bytestring >= 0.9 && < 0.10,
43+ deepseq >= 1.1 && < 1.2,
44+ directory >= 1.1 && < 1.2,
45+ random >= 1.0 && < 1.1,
46+ QuickCheck >= 2.4 && < 2.5,
47+ HUnit >= 1.2 && < 1.3,
48+ test-framework >= 0.4 && < 0.5,
49+ test-framework-quickcheck2 >= 0.2 && < 0.3,
50+ test-framework-hunit >= 0.2 && < 0.3
51+
52+executable text-tests-stdio
53+ hs-source-dirs: src
54+ main-is: Data/Text/Tests/IO.hs
55+
56+ ghc-options:
57+ -Wall
58+ -threaded
59+
60+ -- Optional HPC support
61+ if flag(hpc)
62+ ghc-options:
63+ -fhpc
64+
65+ build-depends:
66+ text-tests,
67+ base >= 4 && < 5
68+
69+library
70+ hs-source-dirs: ../..
71+ exposed-modules:
72+ Data.Text
73+ Data.Text.Array
74+ Data.Text.Encoding
75+ Data.Text.Encoding.Error
76+ Data.Text.Foreign
77+ Data.Text.IO
78+ Data.Text.Internal
79+ Data.Text.Lazy
80+ Data.Text.Lazy.Builder
81+ Data.Text.Lazy.Builder.Int
82+ Data.Text.Lazy.Builder.RealFloat
83+ Data.Text.Lazy.Encoding
84+ Data.Text.Lazy.IO
85+ Data.Text.Lazy.Internal
86+ Data.Text.Lazy.Read
87+ Data.Text.Read
88+ Data.Text.Encoding.Fusion
89+ Data.Text.Encoding.Fusion.Common
90+ Data.Text.Encoding.Utf16
91+ Data.Text.Encoding.Utf32
92+ Data.Text.Encoding.Utf8
93+ Data.Text.Fusion
94+ Data.Text.Fusion.CaseMapping
95+ Data.Text.Fusion.Common
96+ Data.Text.Fusion.Internal
97+ Data.Text.Fusion.Size
98+ Data.Text.IO.Internal
99+ Data.Text.Lazy.Builder.Functions
100+ Data.Text.Lazy.Builder.RealFloat.Functions
101+ Data.Text.Lazy.Encoding.Fusion
102+ Data.Text.Lazy.Fusion
103+ Data.Text.Lazy.Search
104+ Data.Text.Search
105+ Data.Text.Unsafe
106+ Data.Text.UnsafeChar
107+ Data.Text.UnsafeShift
108+ Data.Text.Util
109+
110+ if flag(hpc)
111+ ghc-options:
112+ -fhpc
113+
114+ cpp-options:
115+ -DHAVE_DEEPSEQ
116+ -DASSERTS
117+ -DINTEGER_GMP
118+
119+ build-depends:
120+ array,
121+ base >= 4 && < 5,
122+ bytestring >= 0.9 && < 1.0,
123+ deepseq >= 1.1 && < 1.2,
124+ integer-gmp >= 0.2 && < 0.3,
125+ ghc-prim >= 0.2 && < 0.3