[Haskell-cafe] catchSTM and asynchronous exceptions

Peter Robinson thaldyron at gmail.com
Sat Jul 18 05:36:33 EDT 2009


I couldn't find any information on whether catchSTM catches
asynchronous exceptions
so I tried to run the following:

import Control.Concurrent.STM
import Control.Concurrent
import Control.Exception
import Prelude hiding (catch)
test = do
  tid <- myThreadId
  forkIO (threadDelay 5000000 >>
          throwTo tid (AssertionFailed "Exception in forked thread!"))
  (atomically $ retry `catchSTM` stmHandler) `catch` (ioHandler tid)

  where
    stmHandler (e::SomeException) = throw $
      AssertionFailed ("Caught Exc. in STM; Rethrowing exception: "++ show e)

    ioHandler tid (e::SomeException) =
      print (tid,"Caught Exception in IO: ",e)

Yielding the following output:
# (ThreadId 6942,"Caught Exception in IO: ",Exception in forked thread!)
Apparently the exception is caught by "catch" and not by "catchSTM".
So the point is that catchSTM is only meant to be used for non-async
exceptions, right?

Regards,
Peter


More information about the Haskell-Cafe mailing list