Add a basic test for uninterruptible masks.

Closes #76.

dejafu-tests/Cases/MultiThreaded.hs

@@ -47,6 +47,7 @@ tests =
     , testGroup "Killing Threads" . tg $
       [ T "no masking" threadKill      $ gives  [Left Deadlock, Right ()]
       , T "masked"     threadKillMask  $ gives' [()]
+      , T "masked (uninterruptible)" threadKillUninterruptibleMask $ gives [Left Deadlock]
       , T "unmasked"   threadKillUmask $ gives  [Left Deadlock, Right ()]
       , T "throw to main (uncaught)" threadKillToMain1 $ gives  [Left UncaughtException]
       , T "throw to main (caught)"   threadKillToMain2 $ gives' [()]
@@ -233,6 +234,16 @@ threadKillMask = do
   killThread tid
   readMVar y
 
+-- | Deadlock trying to throw an exception to an
+-- uninterruptibly-masked thread.
+threadKillUninterruptibleMask :: MonadConc m => m ()
+threadKillUninterruptibleMask = do
+  x <- newEmptyMVar
+  y <- newEmptyMVar
+  tid <- fork $ uninterruptibleMask $ \_ -> putMVar x () >> takeMVar y
+  readMVar x
+  killThread tid
+
 -- | Sometimes deadlock by killing a thread.
 threadKillUmask :: MonadConc m => m ()
 threadKillUmask = do