Add tests from testsuite/tests/h98

[ghc-base.git] / GHC / IOBase.hs

diff --git a/GHC/IOBase.hs b/GHC/IOBase.hs
index cbadc87..4177b07 100644 (file)
--- a/GHC/IOBase.hs
+++ b/GHC/IOBase.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# OPTIONS_HADDOCK hide #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IOBase
@@ -50,6 +52,7 @@ module GHC.IOBase {-# DEPRECATED "use GHC.IO instead" #-} (
     blockedOnDeadMVar, blockedIndefinitely
   ) where
 
+import GHC.Base
 import GHC.Exception
 import GHC.IO
 import GHC.IO.Handle.Types
@@ -59,5 +62,32 @@ import GHC.IOArray
 import GHC.IORef
 import GHC.MVar
 import Foreign.C.Types
+import GHC.Show
+import Data.Typeable
 
 type FD = CInt
+
+-- Backwards compat: this was renamed to BlockedIndefinitelyOnMVar
+data BlockedOnDeadMVar = BlockedOnDeadMVar
+    deriving Typeable
+
+instance Exception BlockedOnDeadMVar
+
+instance Show BlockedOnDeadMVar where
+    showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"
+
+blockedOnDeadMVar :: SomeException -- for the RTS
+blockedOnDeadMVar = toException BlockedOnDeadMVar
+
+
+-- Backwards compat: this was renamed to BlockedIndefinitelyOnSTM
+data BlockedIndefinitely = BlockedIndefinitely
+    deriving Typeable
+
+instance Exception BlockedIndefinitely
+
+instance Show BlockedIndefinitely where
+    showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
+
+blockedIndefinitely :: SomeException -- for the RTS
+blockedIndefinitely = toException BlockedIndefinitely