Bugs item #1190056, was opened at 2005-04-26 07:35
Message generated for change (Tracker Item Submitted) made by Item Submitter
You can respond by visiting:
https://sourceforge.net/tracker/?func=detail&atid=108032&aid=1190056&group_id=8032
Category: Compiler
Group: None
Status: Open
Resolution: None
Priority: 2
Submitted By: Simon Peyton Jones (simonpj)
Assigned to: Nobody/Anonymous (nobody)
Summary: Infinite loops can hang Concurrent Haskell
Initial Comment:
An infinite loop that does not allocate can hang
Concurrent Haskell, becuase no thread switching
occurs. Demo code below (from Koen Claessen).
Bites occasionally, but not often.
Simon
module Main where
import Control.Concurrent
( forkIO
, threadDelay
, killThread
, newEmptyMVar
, takeMVar
, putMVar
)
import Data.IORef
import IO( hFlush, stdout )
timeout :: Int -> a -> IO (Maybe a)
timeout n x =
do put "Race starts ..."
resV <- newEmptyMVar
pidV <- newEmptyMVar
let waitAndFail =
do put "Waiting ..."
threadDelay n
put "Done waiting!"
putMVar resV Nothing
eval =
do put "Evaluating ..."
x `seq` put "Done!"
putMVar resV (Just x)
-- used "mfix" here before but got non-termination
problems
-- (not sure they had anything to do with mfix)
pid1 <- forkIO $ do pid2 <- takeMVar pidV
eval
killThread pid2
pid2 <- forkIO $ do waitAndFail
killThread pid1
putMVar pidV pid2
put "Blocking ..."
takeMVar resV
put s =
do putStrLn s
hFlush stdout
main =
do timeout 1 (sum (repeat 1))
<<<
The above program produces the following (expected
result):
>>>
Race starts ...
Blocking ...
Evaluating ...
Waiting ...
Done waiting!
<<<
If you replace 'sum (repeat 1)' by 'last (repeat 1)' the
program hangs.
----------------------------------------------------------------------
You can respond by visiting:
https://sourceforge.net/tracker/?func=detail&atid=108032&aid=1190056&group_id=8032
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
