@@ -1,6 +1,8 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
1-- Regression tests for specific bugs.
3-- Regression tests for specific bugs.
3−import Control.Exception (bracket)
5+import Control.Exception (SomeException, bracket, handle)
4import Control.Monad (when)
6import Control.Monad (when)
5import System.Directory (removeFile)
7import System.Directory (removeFile)
6import System.IO
8import System.IO
@@ -11,6 +13,7 @@ import qualified Data.Text.Lazy as LT
11import qualified Data.Text.Lazy.Encoding as LE
13import qualified Data.Text.Lazy.Encoding as LE
12import qualified Test.Framework as F
14import qualified Test.Framework as F
13import qualified Test.Framework.Providers.HUnit as F
15import qualified Test.Framework.Providers.HUnit as F
16+import Test.HUnit (assertFailure)
15withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
18withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
@@ -29,11 +32,11 @@ lazy_encode_crash = withTempFile $ \ _ h ->
29-- encoded file can result in a crash in the RTS (i.e. not merely an
32-- encoded file can result in a crash in the RTS (i.e. not merely an
30-- exception).
33-- exception).
31hGetContents_crash = withTempFile $ \ path h -> do
34hGetContents_crash = withTempFile $ \ path h -> do
32− B.hPut h (B.pack [0x78, 0xc4 ,0x0a])
35+ B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h
34 h' <- openFile path ReadMode
36 h' <- openFile path ReadMode
35− --hSetEncoding h' utf8
37+ hSetEncoding h' utf8
38+ handle (\(_::SomeException) -> return ()) $
36− T.hGetContents h' >>= print
39+ T.hGetContents h' >> assertFailure "T.hGetContents should crash"
38tests :: F.Test
41tests :: F.Test
39tests = F.testGroup "crashers" [
42tests = F.testGroup "crashers" [