on master help sign in
Add a test case for the Laeremans bug.

--HG-- extra : convert_revision : 65cb90a96826bedfdb87aecb0fb8be1f6e02b6b6

commit04f2b53ec4dcfd1724dd79d163ff30ac3e395b1d authorBryan O'Sullivan <bos@serpentine.com> dateThu 26 Aug 2010, 01:05 (16 years ago) parent749c5c8
1 file changed+25−6
tests/Regressions.hs+25−6
tests/Regressions.hs+25−6
@@ -1,25 +1,44 @@
11-- Regression tests for specific bugs.
22
33import Control.Exception (bracket)
4+import Control.Monad (when)
45import System.Directory (removeFile)
5−import System.IO (hClose, openTempFile)
6+import System.IO
7+import qualified Data.ByteString as B
68import qualified Data.ByteString.Lazy as LB
9+import qualified Data.Text.IO as T
710import qualified Data.Text.Lazy as LT
811import qualified Data.Text.Lazy.Encoding as LE
912import qualified Test.Framework as F
1013import qualified Test.Framework.Providers.HUnit as F
1114
15+withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
16+ where
17+ cleanupTemp (path,h) = do
18+ open <- hIsOpen h
19+ when open (hClose h)
20+ removeFile path
21+
1222-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring
1323-- caused either a segfault or attempt to allocate a negative number
1424-- of bytes.
15−lazy_encode_crash =
16− bracket (openTempFile "." "crashy.txt")
17− (\(path,h) -> hClose h >> removeFile path) $
18− \(_,h) -> LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
25+lazy_encode_crash = withTempFile $ \ _ h ->
26+ LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'
27+
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
30+-- exception).
31+hGetContents_crash = withTempFile $ \ path h -> do
32+ B.hPut h (B.pack [0x78, 0xc4 ,0x0a])
33+ hClose h
34+ h' <- openFile path ReadMode
35+ --hSetEncoding h' utf8
36+ T.hGetContents h' >>= print
1937
2038tests :: F.Test
2139tests = F.testGroup "crashers" [
22− F.testCase "lazy_encode_crash" lazy_encode_crash
40+ F.testCase "hGetContents_crash" hGetContents_crash
41+ , F.testCase "lazy_encode_crash" lazy_encode_crash
2342 ]
2443
2544main = F.defaultMain [tests]