on master help sign in
Improve the hGetContents crash test

--HG-- extra : convert_revision : 87520c0e04b00779a06d0153759f453628c6ffdf

commit741d65df0cd4d6494bd0751d87e577c8d5d4bf12 authorBryan O'Sullivan <bos@serpentine.com> dateThu 26 Aug 2010, 02:12 (16 years ago) parent5ac1d3a
1 file changed+8−5
tests/Regressions.hs+8−5
tests/Regressions.hs+8−5
@@ -1,6 +1,8 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
2+
13-- Regression tests for specific bugs.
24
3−import Control.Exception (bracket)
5+import Control.Exception (SomeException, bracket, handle)
46import Control.Monad (when)
57import System.Directory (removeFile)
68import System.IO
@@ -11,6 +13,7 @@ import qualified Data.Text.Lazy as LT
1113import qualified Data.Text.Lazy.Encoding as LE
1214import qualified Test.Framework as F
1315import qualified Test.Framework.Providers.HUnit as F
16+import Test.HUnit (assertFailure)
1417
1518withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
1619 where
@@ -29,11 +32,11 @@ lazy_encode_crash = withTempFile $ \ _ h ->
2932-- encoded file can result in a crash in the RTS (i.e. not merely an
3033-- exception).
3134hGetContents_crash = withTempFile $ \ path h -> do
32− B.hPut h (B.pack [0x78, 0xc4 ,0x0a])
33− hClose h
35+ B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h
3436 h' <- openFile path ReadMode
35− --hSetEncoding h' utf8
36− T.hGetContents h' >>= print
37+ hSetEncoding h' utf8
38+ handle (\(_::SomeException) -> return ()) $
39+ T.hGetContents h' >> assertFailure "T.hGetContents should crash"
3740
3841tests :: F.Test
3942tests = F.testGroup "crashers" [