Ticket #2638: rcTest.hs

File rcTest.hs, 1.4 KB (added by sclv, 6 years ago)

testcase

Line 
1module Main where
2
3import System.Process
4import System.Environment
5import System.IO
6import Control.Concurrent
7import Control.Monad
8
9-- This demonstrates two bugs in the windows implementatioon of runInteractiveCommand (and probably runCommand as well).
10
11main = do
12 hSetBuffering stdout NoBuffering
13 args <- getArgs
14 pn <- getProgName
15 case args of
16   ("read":_)   -> putStrLn "inread" >> getLine >>= putStrLn >> getLine >> return ()
17   ("noread":_) -> forever $ threadDelay 1000000
18
19   ("master":"read":_) -> do
20                    (inh,outh,errh,ph) <- runInteractiveCommand (pn ++ " read")
21                    hPutStrLn inh "foo"
22                    putStrLn "The task manager should show the child instance producing a slow but real memory leak."
23                    forever $ threadDelay 1000000
24                    hPutStrLn inh "bar" --NB: this line so inh doesn't get
25                                        --garbage collected.
26
27   ("master":"noread":_) -> do
28                    (inh,outh,errh,ph) <- runInteractiveCommand (pn ++ " noread")
29                    threadDelay 1000000
30                    hClose outh
31                    hClose errh
32                    terminateProcess ph
33                    putStrLn . show =<< waitForProcess ph
34                    putStrLn "We were told the process died with the above exit code but check the task manager..."
35                    forever $ threadDelay 1000000