blob: 6d962fd94e456b39e7b6af12c4706ccedbb99c8d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
-- Test for #3128, file descriptor leak when hClose fails
import System.IO
import Control.Exception
import Data.Char
import System.Posix
import qualified GHC.IO.Device as IODevice
import GHC.IO.Handle
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types
import System.Posix.Internals
main = do
(read,write) <- createPipe
hread <- fdToHandle read
hwrite <- fdToHandle write
-- close the FD without telling the IO library:
showPossibleException (hClose hread)
hIsOpen hread >>= print
-- put some data in the Handle's write buffer:
hPutStr hwrite "testing"
-- now try to close the Handle:
showPossibleException (hClose hwrite)
hIsOpen hwrite >>= print
showPossibleException :: IO () -> IO ()
showPossibleException f = do
e <- try f
putStrLn (sanitise (show (e :: Either SomeException ())))
where
-- we don't care which file descriptor it is
sanitise [] = []
sanitise (x:xs) = if isDigit x then ('X':(sanitise' xs)) else (x:(sanitise xs))
sanitise' [] = []
sanitise' (x:xs) = if isDigit x then (sanitise' xs) else (x:(sanitise xs))
naughtyClose h =
withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} ->
IODevice.close dev
|