@@ -1,25 +1,44 @@
1-- Regression tests for specific bugs.
1-- Regression tests for specific bugs.
3import Control.Exception (bracket)
3import Control.Exception (bracket)
4+import Control.Monad (when)
4import System.Directory (removeFile)
5import System.Directory (removeFile)
5−import System.IO (hClose, openTempFile)
6+import System.IO
7+import qualified Data.ByteString as B
6import qualified Data.ByteString.Lazy as LB
8import qualified Data.ByteString.Lazy as LB
9+import qualified Data.Text.IO as T
7import qualified Data.Text.Lazy as LT
10import qualified Data.Text.Lazy as LT
8import qualified Data.Text.Lazy.Encoding as LE
11import qualified Data.Text.Lazy.Encoding as LE
9import qualified Test.Framework as F
12import qualified Test.Framework as F
10import qualified Test.Framework.Providers.HUnit as F
13import qualified Test.Framework.Providers.HUnit as F
15+withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
17+ cleanupTemp (path,h) = do
12-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
22-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
13-- caused either a segfault or attempt to allocate a negative number
23-- caused either a segfault or attempt to allocate a negative number
14-- of bytes.
24-- of bytes.
15−lazy_encode_crash =
25+lazy_encode_crash = withTempFile $ \ _ h ->
16− bracket (openTempFile "." "crashy.txt")
17− (\(path,h) -> hClose h >> removeFile path) $
18− \(_,h) -> LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
26+ LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
28+-- Reported by Pieter Laeremans: attempting to read an incorrectly
29+-- encoded file can result in a crash in the RTS (i.e. not merely an
31+hGetContents_crash = withTempFile $ \ path h -> do
32+ B.hPut h (B.pack [0x78, 0xc4 ,0x0a])
34+ h' <- openFile path ReadMode
35+ --hSetEncoding h' utf8
36+ T.hGetContents h' >>= print
20tests :: F.Test
38tests :: F.Test
21tests = F.testGroup "crashers" [
39tests = F.testGroup "crashers" [
40+ F.testCase "hGetContents_crash" hGetContents_crash
22− F.testCase "lazy_encode_crash" lazy_encode_crash
41+ , F.testCase "lazy_encode_crash" lazy_encode_crash
25main = F.defaultMain [tests]
44main = F.defaultMain [tests]