git.iko.soy/text
on master help sign in
Merge 420d46b4289a8802c82e75828e701e7111d35a7b into f23938f81ec4b912f5f7822fef01a4a6b0133fcf
commit47dd97bed3607592b75eac356226fe0fbb6596f5 authorGitHub Merge Button <merge-button@github.com> dateThu 23 Jun 2011, 13:41 (15 years ago) parentf23938f420d46b
17 files changed+1071−1155
compare with master
unifiedsplit
tests/Chartem.hs−153 tests/Makefile−96 tests/QuickCheckUtils.hs−155 tests/README.markdown+15−1 tests/SearchBench.hs−115 tests/TestUtils.hs−31 tests/tests/.ghci+1 tests/tests/Makefile+29 tests/cover-stdio.sh → tests/tests/scripts/cover-stdio.sh+6−1 tests/tests/src/Data/Text/Tests.hs+13 tests/StdioCoverage.hs → tests/tests/src/Data/Text/Tests/IO.hs+12−3 tests/Properties.hs → tests/tests/src/Data/Text/Tests/Properties.hs+463−587 tests/tests/src/Data/Text/Tests/QuickCheckUtils.hs+337 tests/Regressions.hs → tests/tests/src/Data/Text/Tests/Regressions.hs+17−11 tests/SlowFunctions.hs → tests/tests/src/Data/Text/Tests/SlowFunctions.hs+1−2 tests/tests/src/Data/Text/Tests/Utils.hs+52 tests/tests/text-tests.cabal+125
tests/Chartem.hsdeleted−153
@@ -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.
1515Functional tests
1616----------------
1717
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`.
1933
2034Benchmarks
2135----------
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 @@
11#!/bin/bash
22
3−exe=./stdio-hpc
3+if [[ $# < 1 ]]; then
4+ echo "Usage: $0 <exe>"
5+ exit 1
6+fi
7+
8+exe=$1
49
510rm -f $exe.tix
611
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)
112import qualified Data.Text as T
213import qualified Data.Text.IO as T
314import qualified Data.Text.Lazy as TL
415import qualified Data.Text.Lazy.IO as TL
5−import System.Environment (getArgs)
6−import System.Exit (exitFailure)
7−import System.IO (hPutStrLn, stderr)
816
17+main :: IO ()
918main = do
1019 args <- getArgs
1120 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+--
13{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
24 ScopedTypeVariables, TypeSynonymInstances, CPP #-}
35{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
6+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
7+module Data.Text.Tests.Properties
8+ (
9+ tests
10+ ) where
411
512import Test.QuickCheck
613import Test.QuickCheck.Monadic
714import Text.Show.Functions ()
815
9−import qualified Data.Bits as Bits (shiftL, shiftR)
10−import Numeric (showHex)
16+import Control.Arrow ((***), second)
17+import Control.Exception (catch)
1118import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
1219import Data.Monoid (Monoid(..))
1320import Data.String (fromString)
14−import Debug.Trace (trace)
15−import Control.Arrow ((***), second)
16−import Control.DeepSeq
21+import Data.Text.Encoding.Error
22+import Data.Text.Foreign
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)
1727import 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
1835import 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
2436import 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
3037import qualified Data.Text.Fusion as S
3138import 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
3342import qualified Data.Text.Lazy.Encoding as EL
3443import qualified Data.Text.Lazy.Fusion as SL
35−import qualified Data.Text.UnsafeShift as U
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)
44+import qualified Data.Text.Lazy.IO as TL
4345import qualified Data.Text.Lazy.Search as S (indices)
44−import qualified 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 =^=
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
51+import qualified Data.Text.Tests.SlowFunctions as Slow
6352
6453t_pack_unpack = (T.unpack . T.pack) `eq` id
6554tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
@@ -90,20 +79,10 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
9079t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
9180tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
9281
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−
10482-- This is a poor attempt to ensure that the error handling paths on
10583-- decode are exercised in some way. Proper testing would be rather
10684-- more involved.
85+t_utf8_err :: DecodeErr -> B.ByteString -> Property
10786t_utf8_err (DE _ de) bs = monadicIO $ do
10887 l <- run $ let len = T.length (E.decodeUtf8With de bs)
10988 in (len `seq` return (Right len)) `catch`
@@ -112,62 +91,11 @@ t_utf8_err (DE _ de) bs = monadicIO $ do
11291 Left err -> assert $ length (show err) >= 0
11392 Right n -> assert $ n >= 0
11493
94+t_utf8_err' :: B.ByteString -> Property
11595t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
11696 Left err -> length (show err) >= 0
11797 Right t -> T.length t >= 0
11898
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−
17199s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
172100 where _types = s :: String
173101sf_Eq p s =
@@ -253,6 +181,8 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)
253181sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)
254182t_map f = map f `eqP` (unpackS . T.map f)
255183tl_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)
256186t_intercalate c = L.intercalate c `eq`
257187 (unpackS . T.intercalate (packS c) . map packS)
258188tl_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)
415345
416346replicate n l = concat (L.replicate n l)
417347
348+s_replicate n = replicate m `eq`
349+ (unpackS . S.replicateI (fromIntegral m) . packS)
350+ where m = fromIntegral (n :: Word8)
418351t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)
419352 where m = fromIntegral (n :: Word8)
420353tl_replicate n = replicate m `eq`
@@ -497,14 +430,18 @@ t_breakOn_id s = squid `eq` (uncurry T.append . T.breakOn s)
497430tl_breakOn_id s = squid `eq` (uncurry TL.append . TL.breakOn s)
498431 where squid t | TL.null s = error "empty"
499432 | otherwise = t
500−t_breakOn_start (NotEmpty s) t = let (_,m) = T.breakOn s t
501− in T.null m || s `T.isPrefixOf` m
502−tl_breakOn_start (NotEmpty s) t = let (_,m) = TL.breakOn s t
503− in TL.null m || s `TL.isPrefixOf` m
504−t_breakOnEnd_end (NotEmpty s) t = let (m,_) = T.breakOnEnd s t
505− in T.null m || s `T.isSuffixOf` m
506−tl_breakOnEnd_end (NotEmpty s) t = let (m,_) = TL.breakOnEnd s t
507− in TL.null m || s `TL.isSuffixOf` m
433+t_breakOn_start (NotEmpty s) t =
434+ let (k,m) = T.breakOn s t
435+ in k `T.isPrefixOf` t && (T.null m || s `T.isPrefixOf` m)
436+tl_breakOn_start (NotEmpty s) t =
437+ let (k,m) = TL.breakOn s t
438+ in k `TL.isPrefixOf` t && TL.null m || s `TL.isPrefixOf` m
439+t_breakOnEnd_end (NotEmpty s) t =
440+ let (m,k) = T.breakOnEnd s t
441+ in k `T.isSuffixOf` t && (T.null m || s `T.isSuffixOf` m)
442+tl_breakOnEnd_end (NotEmpty s) t =
443+ let (m,k) = TL.breakOnEnd s t
444+ in k `TL.isSuffixOf` t && (TL.null m || s `TL.isSuffixOf` m)
508445t_break p = L.break p `eqP` (unpack2 . T.break p)
509446tl_break p = L.break p `eqP` (unpack2 . TL.break p)
510447t_group = L.group `eqP` (map unpackS . T.group)
@@ -722,75 +659,12 @@ tl_rational = tl_read_rational TL.rational 1e-16
722659
723660-- Input and output.
724661
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−
788662t_put_get = write_read T.unlines T.filter put get
789− where put h = withRedirect h stdout . T.putStr
790− get h = withRedirect h stdin T.getContents
663+ where put h = withRedirect h IO.stdout . T.putStr
664+ get h = withRedirect h IO.stdin T.getContents
791665tl_put_get = write_read TL.unlines TL.filter put get
792− where put h = withRedirect h stdout . TL.putStr
793− get h = withRedirect h stdin TL.getContents
666+ where put h = withRedirect h IO.stdout . TL.putStr
667+ get h = withRedirect h IO.stdin TL.getContents
794668t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
795669tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
796670
@@ -820,421 +694,423 @@ shorten n t@(S.Stream arr off len)
820694 | n > 0 = S.Stream arr off (smaller (exactSize n) len)
821695 | otherwise = t
822696
823−main = defaultMain tests
824−
825−tests = [
826− testGroup "creation/elimination" [
827− testProperty "t_pack_unpack" t_pack_unpack,
828− testProperty "tl_pack_unpack" tl_pack_unpack,
829− testProperty "t_stream_unstream" t_stream_unstream,
830− testProperty "tl_stream_unstream" tl_stream_unstream,
831− testProperty "t_reverse_stream" t_reverse_stream,
832− testProperty "t_singleton" t_singleton,
833− testProperty "tl_singleton" tl_singleton,
834− testProperty "tl_unstreamChunks" tl_unstreamChunks,
835− testProperty "tl_chunk_unchunk" tl_chunk_unchunk,
836− 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
697+tests :: Test
698+tests =
699+ testGroup "Properties" [
700+ testGroup "creation/elimination" [
701+ testProperty "t_pack_unpack" t_pack_unpack,
702+ testProperty "tl_pack_unpack" tl_pack_unpack,
703+ testProperty "t_stream_unstream" t_stream_unstream,
704+ testProperty "tl_stream_unstream" tl_stream_unstream,
705+ testProperty "t_reverse_stream" t_reverse_stream,
706+ testProperty "t_singleton" t_singleton,
707+ testProperty "tl_singleton" tl_singleton,
708+ testProperty "tl_unstreamChunks" tl_unstreamChunks,
709+ testProperty "tl_chunk_unchunk" tl_chunk_unchunk,
710+ testProperty "tl_from_to_strict" tl_from_to_strict
963711 ],
964712
965− testGroup "justification" [
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,
1000− testProperty "sf_concat" sf_concat,
1001− testProperty "t_concat" t_concat,
1002− testProperty "tl_concat" tl_concat,
1003− testProperty "sf_concatMap" sf_concatMap,
1004− testProperty "t_concatMap" t_concatMap,
1005− testProperty "tl_concatMap" tl_concatMap,
1006− testProperty "sf_any" sf_any,
1007− testProperty "t_any" t_any,
1008− testProperty "tl_any" tl_any,
1009− testProperty "sf_all" sf_all,
1010− testProperty "t_all" t_all,
1011− testProperty "tl_all" tl_all,
1012− testProperty "sf_maximum" sf_maximum,
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" [
1022− testGroup "scans" [
1023− testProperty "sf_scanl" sf_scanl,
1024− testProperty "t_scanl" t_scanl,
1025− testProperty "tl_scanl" tl_scanl,
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
713+ testGroup "transcoding" [
714+ testProperty "t_ascii" t_ascii,
715+ testProperty "tl_ascii" tl_ascii,
716+ testProperty "t_utf8" t_utf8,
717+ testProperty "t_utf8'" t_utf8',
718+ testProperty "tl_utf8" tl_utf8,
719+ testProperty "tl_utf8'" tl_utf8',
720+ testProperty "t_utf16LE" t_utf16LE,
721+ testProperty "tl_utf16LE" tl_utf16LE,
722+ testProperty "t_utf16BE" t_utf16BE,
723+ testProperty "tl_utf16BE" tl_utf16BE,
724+ testProperty "t_utf32LE" t_utf32LE,
725+ testProperty "tl_utf32LE" tl_utf32LE,
726+ testProperty "t_utf32BE" t_utf32BE,
727+ testProperty "tl_utf32BE" tl_utf32BE,
728+ testGroup "errors" [
729+ testProperty "t_utf8_err" t_utf8_err,
730+ testProperty "t_utf8_err'" t_utf8_err'
731+ ]
1032732 ],
1033733
1034− testGroup "mapAccum" [
1035− testProperty "t_mapAccumL" t_mapAccumL,
1036− testProperty "tl_mapAccumL" tl_mapAccumL,
1037− testProperty "t_mapAccumR" t_mapAccumR,
1038− testProperty "tl_mapAccumR" tl_mapAccumR
734+ testGroup "instances" [
735+ testProperty "s_Eq" s_Eq,
736+ testProperty "sf_Eq" sf_Eq,
737+ testProperty "t_Eq" t_Eq,
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
1039755 ],
1040756
1041− testGroup "unfolds" [
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,
1054− testProperty "s_take_s" s_take_s,
1055− testProperty "sf_take" sf_take,
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,
1064− testProperty "s_take_drop_s" s_take_drop_s,
1065− testProperty "s_takeWhile" s_takeWhile,
1066− testProperty "s_takeWhile_s" s_takeWhile_s,
1067− testProperty "sf_takeWhile" sf_takeWhile,
1068− testProperty "t_takeWhile" t_takeWhile,
1069− testProperty "tl_takeWhile" tl_takeWhile,
1070− testProperty "sf_dropWhile" sf_dropWhile,
1071− testProperty "s_dropWhile" s_dropWhile,
1072− testProperty "s_dropWhile_s" s_dropWhile_s,
1073− testProperty "t_dropWhile" t_dropWhile,
1074− testProperty "tl_dropWhile" tl_dropWhile,
1075− testProperty "t_dropWhileEnd" t_dropWhileEnd,
1076− testProperty "tl_dropWhileEnd" tl_dropWhileEnd,
1077− testProperty "t_dropAround" t_dropAround,
1078− testProperty "tl_dropAround" tl_dropAround,
1079− testProperty "t_stripStart" t_stripStart,
1080− testProperty "tl_stripStart" tl_stripStart,
1081− testProperty "t_stripEnd" t_stripEnd,
1082− testProperty "tl_stripEnd" tl_stripEnd,
1083− testProperty "t_strip" t_strip,
1084− testProperty "tl_strip" tl_strip,
1085− testProperty "t_splitAt" t_splitAt,
1086− testProperty "tl_splitAt" tl_splitAt,
1087− testProperty "t_span" t_span,
1088− testProperty "tl_span" tl_span,
1089− testProperty "t_breakOn_id" t_breakOn_id,
1090− testProperty "tl_breakOn_id" tl_breakOn_id,
1091− testProperty "t_breakOn_start" t_breakOn_start,
1092− testProperty "tl_breakOn_start" tl_breakOn_start,
1093− testProperty "t_breakOnEnd_end" t_breakOnEnd_end,
1094− testProperty "tl_breakOnEnd_end" tl_breakOnEnd_end,
1095− testProperty "t_break" t_break,
1096− testProperty "tl_break" tl_break,
1097− testProperty "t_group" t_group,
1098− testProperty "tl_group" tl_group,
1099− testProperty "t_groupBy" t_groupBy,
1100− testProperty "tl_groupBy" tl_groupBy,
1101− testProperty "t_inits" t_inits,
1102− testProperty "tl_inits" tl_inits,
1103− testProperty "t_tails" t_tails,
1104− testProperty "tl_tails" tl_tails
757+ testGroup "basics" [
758+ testProperty "s_cons" s_cons,
759+ testProperty "s_cons_s" s_cons_s,
760+ testProperty "sf_cons" sf_cons,
761+ testProperty "t_cons" t_cons,
762+ testProperty "tl_cons" tl_cons,
763+ testProperty "s_snoc" s_snoc,
764+ testProperty "t_snoc" t_snoc,
765+ testProperty "tl_snoc" tl_snoc,
766+ testProperty "s_append" s_append,
767+ testProperty "s_append_s" s_append_s,
768+ testProperty "sf_append" sf_append,
769+ testProperty "t_append" t_append,
770+ testProperty "s_uncons" s_uncons,
771+ testProperty "sf_uncons" sf_uncons,
772+ testProperty "t_uncons" t_uncons,
773+ testProperty "tl_uncons" tl_uncons,
774+ testProperty "s_head" s_head,
775+ testProperty "sf_head" sf_head,
776+ testProperty "t_head" t_head,
777+ testProperty "tl_head" tl_head,
778+ testProperty "s_last" s_last,
779+ testProperty "sf_last" sf_last,
780+ testProperty "t_last" t_last,
781+ testProperty "tl_last" tl_last,
782+ testProperty "s_tail" s_tail,
783+ testProperty "s_tail_s" s_tail_s,
784+ testProperty "sf_tail" sf_tail,
785+ testProperty "t_tail" t_tail,
786+ testProperty "tl_tail" tl_tail,
787+ testProperty "s_init" s_init,
788+ testProperty "s_init_s" s_init_s,
789+ testProperty "sf_init" sf_init,
790+ testProperty "t_init" t_init,
791+ testProperty "tl_init" tl_init,
792+ testProperty "s_null" s_null,
793+ testProperty "sf_null" sf_null,
794+ testProperty "t_null" t_null,
795+ testProperty "tl_null" tl_null,
796+ testProperty "s_length" s_length,
797+ testProperty "sf_length" sf_length,
798+ testProperty "sl_length" sl_length,
799+ testProperty "t_length" t_length,
800+ testProperty "tl_length" tl_length,
801+ testProperty "t_compareLength" t_compareLength,
802+ testProperty "tl_compareLength" tl_compareLength
1105803 ],
1106804
1107− testGroup "breaking many" [
1108− testProperty "t_findAppendId" t_findAppendId,
1109− testProperty "tl_findAppendId" tl_findAppendId,
1110− testProperty "t_findContains" t_findContains,
1111− testProperty "tl_findContains" tl_findContains,
1112− testProperty "sl_filterCount" sl_filterCount,
1113− testProperty "t_findCount" t_findCount,
1114− testProperty "tl_findCount" tl_findCount,
1115− testProperty "t_splitOn_split" t_splitOn_split,
1116− testProperty "tl_splitOn_split" tl_splitOn_split,
1117− testProperty "t_splitOn_i" t_splitOn_i,
1118− testProperty "tl_splitOn_i" tl_splitOn_i,
1119− testProperty "t_split" t_split,
1120− testProperty "t_split_count" t_split_count,
1121− testProperty "t_split_splitOn" t_split_splitOn,
1122− testProperty "tl_split" tl_split,
1123− testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,
1124− testProperty "t_chunksOf_length" t_chunksOf_length,
1125− testProperty "tl_chunksOf" tl_chunksOf
805+ testGroup "transformations" [
806+ testProperty "s_map" s_map,
807+ testProperty "s_map_s" s_map_s,
808+ testProperty "sf_map" sf_map,
809+ testProperty "t_map" t_map,
810+ testProperty "tl_map" tl_map,
811+ testProperty "s_intercalate" s_intercalate,
812+ testProperty "t_intercalate" t_intercalate,
813+ testProperty "tl_intercalate" tl_intercalate,
814+ testProperty "s_intersperse" s_intersperse,
815+ testProperty "s_intersperse_s" s_intersperse_s,
816+ testProperty "sf_intersperse" sf_intersperse,
817+ testProperty "t_intersperse" t_intersperse,
818+ testProperty "tl_intersperse" tl_intersperse,
819+ testProperty "t_transpose" t_transpose,
820+ testProperty "tl_transpose" tl_transpose,
821+ testProperty "t_reverse" t_reverse,
822+ testProperty "tl_reverse" tl_reverse,
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+ ]
1126851 ],
1127852
1128− testGroup "lines and words" [
1129− testProperty "t_lines" t_lines,
1130− testProperty "tl_lines" tl_lines,
1131− --testProperty "t_lines'" t_lines',
1132− testProperty "t_words" t_words,
1133− testProperty "tl_words" tl_words,
1134− testProperty "t_unlines" t_unlines,
1135− testProperty "tl_unlines" tl_unlines,
1136− testProperty "t_unwords" t_unwords,
1137− testProperty "tl_unwords" tl_unwords
1138− ]
1139− ],
1140−
1141− testGroup "predicates" [
1142− testProperty "s_isPrefixOf" s_isPrefixOf,
1143− testProperty "sf_isPrefixOf" sf_isPrefixOf,
1144− testProperty "t_isPrefixOf" t_isPrefixOf,
1145− testProperty "tl_isPrefixOf" tl_isPrefixOf,
1146− testProperty "t_isSuffixOf" t_isSuffixOf,
1147− testProperty "tl_isSuffixOf" tl_isSuffixOf,
1148− testProperty "t_isInfixOf" t_isInfixOf,
1149− testProperty "tl_isInfixOf" tl_isInfixOf,
1150−
1151− testGroup "view" [
1152− testProperty "t_stripPrefix" t_stripPrefix,
1153− testProperty "tl_stripPrefix" tl_stripPrefix,
1154− testProperty "t_stripSuffix" t_stripSuffix,
1155− testProperty "tl_stripSuffix" tl_stripSuffix,
1156− testProperty "t_commonPrefixes" t_commonPrefixes,
1157− testProperty "tl_commonPrefixes" tl_commonPrefixes
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+
1004+ testGroup "lines and words" [
1005+ testProperty "t_lines" t_lines,
1006+ testProperty "tl_lines" tl_lines,
1007+ --testProperty "t_lines'" t_lines',
1008+ testProperty "t_words" t_words,
1009+ testProperty "tl_words" tl_words,
1010+ testProperty "t_unlines" t_unlines,
1011+ testProperty "tl_unlines" tl_unlines,
1012+ testProperty "t_unwords" t_unwords,
1013+ testProperty "tl_unwords" tl_unwords
1014+ ]
1015+ ],
1016+
1017+ testGroup "predicates" [
1018+ testProperty "s_isPrefixOf" s_isPrefixOf,
1019+ testProperty "sf_isPrefixOf" sf_isPrefixOf,
1020+ testProperty "t_isPrefixOf" t_isPrefixOf,
1021+ testProperty "tl_isPrefixOf" tl_isPrefixOf,
1022+ testProperty "t_isSuffixOf" t_isSuffixOf,
1023+ testProperty "tl_isSuffixOf" tl_isSuffixOf,
1024+ testProperty "t_isInfixOf" t_isInfixOf,
1025+ testProperty "tl_isInfixOf" tl_isInfixOf,
1026+
1027+ testGroup "view" [
1028+ testProperty "t_stripPrefix" t_stripPrefix,
1029+ testProperty "tl_stripPrefix" tl_stripPrefix,
1030+ testProperty "t_stripSuffix" t_stripSuffix,
1031+ testProperty "tl_stripSuffix" tl_stripSuffix,
1032+ testProperty "t_commonPrefixes" t_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
11581115 ]
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
12391116 ]
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+--
13{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
2−
3−-- Regression tests for specific bugs.
4+module Data.Text.Tests.Regressions
5+ (
6+ tests
7+ ) where
48
59import Control.Exception (SomeException, handle)
610import System.IO
11+import Test.HUnit (assertFailure)
712import qualified Data.ByteString as B
813import qualified Data.ByteString.Lazy as LB
914import qualified Data.Text as T
@@ -12,18 +17,20 @@ import qualified Data.Text.Lazy as LT
1217import qualified Data.Text.Lazy.Encoding as LE
1318import qualified Test.Framework as F
1419import qualified Test.Framework.Providers.HUnit as F
15−import Test.HUnit (assertFailure)
16−import TestUtils (withTempFile)
20+
21+import Data.Text.Tests.Utils (withTempFile)
1722
1823-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
1924-- caused either a segfault or attempt to allocate a negative number
2025-- of bytes.
26+lazy_encode_crash :: IO ()
2127lazy_encode_crash = withTempFile $ \ _ h ->
2228 LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
2329
2430-- Reported by Pieter Laeremans: attempting to read an incorrectly
2531-- encoded file can result in a crash in the RTS (i.e. not merely an
2632-- exception).
33+hGetContents_crash :: IO ()
2734hGetContents_crash = withTempFile $ \ path h -> do
2835 B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h
2936 h' <- openFile path ReadMode
@@ -34,6 +41,7 @@ hGetContents_crash = withTempFile $ \ path h -> do
3441-- Reported by Ian Lynagh: attempting to allocate a sufficiently large
3542-- string (via either Array.new or Text.replicate) could result in an
3643-- integer overflow.
44+replicate_crash :: IO ()
3745replicate_crash = handle (\(_::SomeException) -> return ()) $
3846 T.replicate (2^power) "0123456789abcdef" `seq`
3947 assertFailure "T.replicate should crash"
@@ -42,10 +50,8 @@ replicate_crash = handle (\(_::SomeException) -> return ()) $
4250 | otherwise = 60 :: Int
4351
4452tests :: F.Test
45−tests = F.testGroup "crashers" [
46− F.testCase "hGetContents_crash" hGetContents_crash
47− , F.testCase "lazy_encode_crash" lazy_encode_crash
48− , F.testCase "replicate_crash" replicate_crash
49− ]
50−
51−main = F.defaultMain [tests]
53+tests = F.testGroup "Regressions"
54+ [ F.testCase "hGetContents_crash" hGetContents_crash
55+ , F.testCase "lazy_encode_crash" lazy_encode_crash
56+ , F.testCase "replicate_crash" replicate_crash
57+ ]
tests/SlowFunctions.hs → tests/tests/src/Data/Text/Tests/SlowFunctions.hsrenamed+1−2
@@ -1,6 +1,5 @@
11{-# LANGUAGE BangPatterns #-}
2−
3−module SlowFunctions
2+module Data.Text.Tests.SlowFunctions
43 (
54 indices
65 , 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