#544 panic! 'impossible' happened, thread blocked indefinitely

[Anonymous]

GHCi, version 6.4.1, crashed with the following error:

ghc-6.4.1: panic! (the `impossible' happened, GHC
version 6.4.1):
thread blocked indefinitely

Please report it as a compiler bug to
glasgow-haskell-bugs@haskell.org,
or http://sourceforge.net/projects/ghc/.

I was calling a test function which was forking a
Thread which was blocking in an 'atomically' waiting
on a TChan.
If I ran the test function a second time, while the
Thread from the first run is presumably still hanging
around, I would receive the above error/crash.

If I reloaded the source in GHCi after running the
test function a single time GHCi would give an error
message (but not crash):

*** Exception: thread blocked indefinitely

Most of the time after the error message there would
be no modules loaded. I could load again, and repeat
the fun.
_Very_ occasionaly the modules would remain loaded and
I could repeat the cycle without having to reload the
modules.

Since fixing my test function so the forked Thread
dies at the desired time (ie now it won't be hanging
around blocked on the TChan) I haven't observed the
failure.

My email: kgrapone@gmail.com

[Nobody/Anonymous]

Logged In: NO

Oh, yeah: Running a 32bit Linux 2.6 kernel

[Simon Marlow]

Logged In: YES
user_id=48280

Please can you supply code to reproduce the bug.

This might be the same bug as #1274506.

[kgrapone]

Logged In: YES
user_id=1397718

Following is a minimal(ish) test case. It behaves a little
differently from the original, seems to be some timing
issues involved.
Running "runTest badLoop" multiple times will eventually
kill GHCi. Interleaving with "runTest goodLoop" will
sometimes get you the other effects I mentioned above.

--BEGIN CODE--
module Test where

import Control.Concurrent.STM
import Control.Concurrent
import Control.Exception
import Prelude hiding (catch)

runTest loop = do
(tc1, tc2, tmv) <- atomically (do
tmv <- newEmptyTMVar
tc1 <- newTChan
tc2 <- newTChan
return (tc1, tc2, tmv)
)
myTId <- myThreadId
forkIO (forked loop (tc1, tc2, tmv, myTId))
atomically (writeTChan tc1 "blah")
atomically (writeTChan tc1 "blah2")
return "done"

forked loop args@(tc1, tc2, tmv, hisTId) = catch ((loop
args) >>= setTMV . Just) hndlr `finally` setTMV Nothing
where
setTMV x = atomically (tryPutTMVar tmv x >>
return ())
hndlr (AsyncException ThreadKilled) = return ()
hndlr e = throwTo
hisTId e

goodLoop args@(tc1, tc2, tmv, hisTId) = do
x <- atomically (readTChan tc1)
x' <- return $ reverse x
atomically (writeTChan tc2 x')
if x == "blah2"
then return ()
else goodLoop args

badLoop args@(tc1, tc2, tmv, hisTId) = do
x <- atomically (readTChan tc1)
x' <- return $ reverse x
atomically (writeTChan tc2 x')
badLoop args
--END CODE--