From: simonmar Date: Tue, 13 Dec 2005 15:57:49 +0000 (+0000) Subject: [project @ 2005-12-13 15:57:49 by simonmar] X-Git-Tag: Initial_conversion_from_CVS_complete~8 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e9db07b2af145dba541f82aeec1b626f572f485f;p=haskell-directory.git [project @ 2005-12-13 15:57:49 by simonmar] Raise the (new) exception NestedAtomically when atomically is nested (using unsafePerformIO). This is a small improvement over crashing. --- diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs index f0ce8de..112268e 100644 --- a/GHC/IOBase.lhs +++ b/GHC/IOBase.lhs @@ -602,6 +602,10 @@ data Exception -- ^The current thread was waiting to retry an atomic memory transaction -- that could never become possible to complete because there are no other -- threads referring to any of teh TVars involved. + | NestedAtomically + -- ^The runtime detected an attempt to nest one STM transaction + -- inside another one, presumably due to the use of + -- 'unsafePeformIO' with 'atomically'. | Deadlock -- ^There are no runnable threads, so the program is -- deadlocked. The 'Deadlock' exception is @@ -740,6 +744,7 @@ instance Show Exception where showsPrec _ (AsyncException e) = shows e showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely" showsPrec _ (BlockedIndefinitely) = showString "thread blocked indefinitely" + showsPrec _ (NestedAtomically) = showString "Control.Concurrent.STM.atomically was nested" showsPrec _ (NonTermination) = showString "<>" showsPrec _ (Deadlock) = showString "<>" @@ -759,6 +764,7 @@ instance Eq Exception where AsyncException e1 == AsyncException e2 = e1 == e2 BlockedOnDeadMVar == BlockedOnDeadMVar = True NonTermination == NonTermination = True + NestedAtomically == NestedAtomically = True Deadlock == Deadlock = True _ == _ = False