37b92cb9e16cf4706e697ce6d37f6c8622e08ec5
[packages/text.git] / tests / Tests / Regressions.hs
1 -- | Regression tests for specific bugs.
2 --
3 {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
4 module Tests.Regressions
5 (
6 tests
7 ) where
8
9 import Control.Exception (SomeException, handle)
10 import Data.Char (isLetter)
11 import System.IO
12 import Test.HUnit (assertBool, assertEqual, assertFailure)
13 import qualified Data.ByteString as B
14 import Data.ByteString.Char8 ()
15 import qualified Data.ByteString.Lazy as LB
16 import qualified Data.Text as T
17 import qualified Data.Text.Encoding as TE
18 import qualified Data.Text.IO as T
19 import qualified Data.Text.Lazy as LT
20 import qualified Data.Text.Lazy.Encoding as LE
21 import qualified Data.Text.Unsafe as T
22 import qualified Test.Framework as F
23 import qualified Test.Framework.Providers.HUnit as F
24
25 import Tests.Utils (withTempFile)
26
27 -- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
28 -- caused either a segfault or attempt to allocate a negative number
29 -- of bytes.
30 lazy_encode_crash :: IO ()
31 lazy_encode_crash = withTempFile $ \ _ h ->
32 LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
33
34 -- Reported by Pieter Laeremans: attempting to read an incorrectly
35 -- encoded file can result in a crash in the RTS (i.e. not merely an
36 -- exception).
37 hGetContents_crash :: IO ()
38 hGetContents_crash = withTempFile $ \ path h -> do
39 B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h
40 h' <- openFile path ReadMode
41 hSetEncoding h' utf8
42 handle (\(_::SomeException) -> return ()) $
43 T.hGetContents h' >> assertFailure "T.hGetContents should crash"
44
45 -- Reported by Ian Lynagh: attempting to allocate a sufficiently large
46 -- string (via either Array.new or Text.replicate) could result in an
47 -- integer overflow.
48 replicate_crash :: IO ()
49 replicate_crash = handle (\(_::SomeException) -> return ()) $
50 T.replicate (2^power) "0123456789abcdef" `seq`
51 assertFailure "T.replicate should crash"
52 where
53 power | maxBound == (2147483647::Int) = 28
54 | otherwise = 60 :: Int
55
56 -- Reported by John Millikin: a UTF-8 decode error handler could
57 -- return a bogus substitution character, which we would write without
58 -- checking.
59 utf8_decode_unsafe :: IO ()
60 utf8_decode_unsafe = do
61 let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"
62 assertBool "broken error recovery shouldn't break us" (t == "\xfffd")
63
64 -- Reported by Eric Seidel: we mishandled mapping Chars that fit in a
65 -- single Word16 to Chars that require two.
66 mapAccumL_resize :: IO ()
67 mapAccumL_resize = do
68 let f a _ = (a, '\65536')
69 count = 5
70 val = T.mapAccumL f (0::Int) (T.replicate count "a")
71 assertEqual "mapAccumL should correctly fill buffers for two-word results"
72 (0, T.replicate count "\65536") val
73 assertEqual "mapAccumL should correctly size buffers for two-word results"
74 (count * 2) (T.lengthWord16 (snd val))
75
76 -- See GitHub #197
77 t197 :: IO ()
78 t197 =
79 assertBool "length (filter (==',') \"0,00\") should be 1" (currencyParser "0,00")
80 where
81 currencyParser x = cond == 1
82 where
83 cond = length fltr
84 fltr = filter (== ',') x
85
86 t227 :: IO ()
87 t227 =
88 assertEqual "take (-3) shouldn't crash with overflow"
89 (T.length $ T.filter isLetter $ T.take (-3) "Hello! How are you doing today?")
90 0
91
92 tests :: F.Test
93 tests = F.testGroup "Regressions"
94 [ F.testCase "hGetContents_crash" hGetContents_crash
95 , F.testCase "lazy_encode_crash" lazy_encode_crash
96 , F.testCase "mapAccumL_resize" mapAccumL_resize
97 , F.testCase "replicate_crash" replicate_crash
98 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
99 , F.testCase "t197" t197
100 , F.testCase "t227" t227
101 ]