blob: 102e8919683215033940de42ea52c1a4d066e2ea (
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
|
{-# Language ScopedTypeVariables #-}
module Main where
import Control.Concurrent
import Control.Exception
import System.IO
import System.Exit
import System.Process
import GHC.IO.Handle.FD
main = do
ecode <- waitForProcess =<< spawnProcess "mkfifo" ["fifo"]
case ecode of
ExitFailure code -> putStrLn "mkfifo failed"
ExitSuccess -> do
passed <- newEmptyMVar
opener <- forkIO $
(openFileBlocking "fifo" WriteMode >> return ())
`catch` \(e:: AsyncException) -> do
if e == ThreadKilled then do
putStrLn "openFileBlocking successfully interrupted"
putMVar passed True
else print e
throwIO e
threadDelay 1000
forkIO $ killThread opener
forkIO $ do
threadDelay (10^6)
putStrLn "timeout!"
putMVar passed False
res <- readMVar passed
case res of
True -> exitSuccess
False -> exitFailure
|
