summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/lib/IO/hClose003.hs
blob: cbaf49d6db541117294509808798f4f8996c9c21 (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} -> do
     IODevice.close dev