From ede84b2aad85b55c616d91e8863f8c8ce8bc17a9 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 17 May 2007 12:21:47 +0000 Subject: [PATCH] rethrow exceptions in sandboxIO This gives us a chance to catch asynchronous exceptions (e.g. ^C) and break. --- compiler/main/InteractiveEval.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index f7e9101..c80f293 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -268,10 +268,18 @@ foreign import ccall "&rts_breakpoint_io_action" sandboxIO :: MVar Status -> IO [HValue] -> IO Status sandboxIO statusMVar thing = withInterruptsSentTo - (forkIO (do res <- Exception.try thing + (forkIO (do res <- Exception.try (rethrow thing) putMVar statusMVar (Complete res))) (takeMVar statusMVar) +-- | this just re-throws any exceptions received. The point of this +-- is that if -fbreak-on-excepsions is on, we only get a chance to break +-- for synchronous exceptions, and this turns an async exception into +-- a sync exception, so for instance a ^C exception will break right here +-- unless it is caught elsewhere. +rethrow :: IO a -> IO a +rethrow io = Exception.catch io Exception.throwIO + withInterruptsSentTo :: IO ThreadId -> IO r -> IO r withInterruptsSentTo io get_result = do ts <- takeMVar interruptTargetThread -- 1.7.10.4