Ticket #2650: handle-inheritance-test.hs

File handle-inheritance-test.hs, 738 bytes (added by Deewiant, 5 years ago)

A better test case than createprocess-race-condition

Line 
1import System.IO
2import System.Process
3
4main = do
5   let s = "foo.tmp"
6   hdl <- openFile s WriteMode
7
8   (_,_,_,pid) <- createProcess $ CreateProcess
9      -- windows doesn't have sleep so we use ping -n as a replacement
10      { cmdspec   = RawCommand "ping" ["-n", "20", "localhost"]
11      , cwd       = Nothing
12      , env       = Nothing
13      , std_in    = CreatePipe
14      , std_out   = CreatePipe
15      , std_err   = CreatePipe
16      , close_fds = True
17      }
18
19   hClose hdl
20   b <- (openFile s WriteMode >> return True) `catch` const (return False)
21   if b
22      then putStrLn "Reopening the file succeeded!"
23      else putStrLn "Reopening the file failed: the child inherited it."
24
25   terminateProcess pid
26   waitForProcess pid