Remove Deadlock / STMDeadlock distinction

dejafu-tests/lib/Integration/SingleThreaded.hs

@@ -137,7 +137,7 @@ stmTests = toTestList
       ctv <- atomically $ newTVarInt 5
       (5==) <$> readTVarConc ctv
 
-  , djfu "Aborting a transaction blocks the thread" (gives [Left STMDeadlock]) $ basic
+  , djfu "Aborting a transaction blocks the thread" (gives [Left Deadlock]) $ basic
       (atomically retry :: MonadConc m => m ()) -- avoid an ambiguous type
 
   , djfu "Aborting a transaction can be caught and recovered from" (gives' [True]) $ basic $ do

dejafu-tests/lib/Unit/Predicates.hs

@@ -21,7 +21,7 @@ alwaysSameBy = toTestList
   [ passes "Equal successes"   (D.alwaysSameBy (==)) [Right 1, Right 1, Right 1]
   , fails  "Unequal successes" (D.alwaysSameBy (==)) [Right 1, Right 2, Right 3]
   , fails  "Equal conditions"   (D.alwaysSameBy (==)) [Left D.Deadlock, Left D.Deadlock, Left D.Deadlock]
-  , fails  "Unequal conditions" (D.alwaysSameBy (==)) [Left D.Deadlock, Left D.STMDeadlock, Left D.Abort]
+  , fails  "Unequal conditions" (D.alwaysSameBy (==)) [Left D.Deadlock, Left D.Abort, Left D.Abort]
   , fails  "Mixed conditions and successes" (D.alwaysSameBy (==)) [Left D.Deadlock, Right 1, Right 1]
   ]
 
@@ -32,7 +32,7 @@ notAlwaysSameBy = toTestList
   [ fails  "Equal successes"   (D.notAlwaysSameBy (==)) [Right 1, Right 1, Right 1]
   , passes "Unequal successes" (D.notAlwaysSameBy (==)) [Right 1, Right 2, Right 3]
   , fails  "Equal conditions"   (D.notAlwaysSameBy (==)) [Left D.Deadlock, Left D.Deadlock, Left D.Deadlock]
-  , fails  "Unequal conditions" (D.notAlwaysSameBy (==)) [Left D.Deadlock, Left D.STMDeadlock, Left D.Abort]
+  , fails  "Unequal conditions" (D.notAlwaysSameBy (==)) [Left D.Deadlock, Left D.Abort, Left D.Abort]
   , fails  "Mixed conditions and successes" (D.notAlwaysSameBy (==)) [Left D.Deadlock, Right 1, Right 1]
   ]
 

dejafu-tests/lib/Unit/Properties.hs

@@ -338,7 +338,6 @@ genCondition :: H.Gen D.Condition
 genCondition = HGen.element $
   [ D.Abort
   , D.Deadlock
-  , D.STMDeadlock
   ] ++ map D.UncaughtException -- have a few different exception types
   [ E.toException E.Overflow
   , E.toException E.ThreadKilled

dejafu/Test/DejaFu.hs

@@ -47,13 +47,10 @@ and, for each, a summarised execution trace leading to that result:
  * Each \"-\" represents one \"step\" of the computation.
 
 __Conditions:__ A program may fail to terminate in a way which
-produces a value. dejafu can detect a few such cases:
+produces a value. dejafu can detect two such cases:
 
  * 'Deadlock', if every thread is blocked.
 
- * 'STMDeadlock', if every thread is blocked /and/ the main thread is
-   blocked in an STM transaction.
-
  * 'UncaughtException', if the main thread is killed by an exception.
 
 __Beware of 'liftIO':__ dejafu works by running your test case lots of

dejafu/Test/DejaFu/Conc/Internal.hs

@@ -149,7 +149,6 @@ runThreads forSnapshot sched memtype ref = schedule (const $ pure ()) Seq.empty
   schedule restore sofar prior ctx
     | isTerminated  = stop restore sofar prior ctx
     | isDeadlocked  = die Deadlock restore sofar prior ctx
-    | isSTMLocked   = die STMDeadlock restore sofar prior ctx
     | otherwise =
       let ctx' = ctx { cSchedState = g' }
       in case choice of
@@ -173,12 +172,7 @@ runThreads forSnapshot sched memtype ref = schedule (const $ pure ()) Seq.empty
       threads       = cThreads ctx
       isBlocked     = isJust . _blocking
       isTerminated  = initialThread `notElem` M.keys threads
-      isDeadlocked  = M.null (M.filter (not . isBlocked) threads) &&
-        (((~=  OnMVarFull  undefined) <$> M.lookup initialThread threads) == Just True ||
-         ((~=  OnMVarEmpty undefined) <$> M.lookup initialThread threads) == Just True ||
-         ((~=  OnMask      undefined) <$> M.lookup initialThread threads) == Just True)
-      isSTMLocked = M.null (M.filter (not . isBlocked) threads) &&
-        ((~=  OnTVar []) <$> M.lookup initialThread threads) == Just True
+      isDeadlocked  = M.null (M.filter (not . isBlocked) threads)
 
   -- run the chosen thread for one step and then pass control back to
   -- 'schedule'

dejafu/Test/DejaFu/Types.hs

@@ -426,7 +426,7 @@ instance NFData Decision
 -- The @Eq@, @Ord@, and @NFData@ instances compare/evaluate the
 -- exception with @show@ in the @UncaughtException@ case.
 --
--- @since 1.12.0.0
+-- @since unreleased
 data Condition
   = Abort
   -- ^ The scheduler chose to abort execution. This will be produced
@@ -434,11 +434,7 @@ data Condition
   -- bounds (there have been too many pre-emptions, the computation
   -- has executed for too long, or there have been too many yields).
   | Deadlock
-  -- ^ Every thread is blocked, and the main thread is /not/ blocked
-  -- in an STM transaction.
-  | STMDeadlock
-  -- ^ Every thread is blocked, and the main thread is blocked in an
-  -- STM transaction.
+  -- ^ Every thread is blocked
   | UncaughtException SomeException
   -- ^ An uncaught exception bubbled to the top of the computation.
   deriving (Show, Generic)
@@ -446,7 +442,6 @@ data Condition
 instance Eq Condition where
   Abort                  == Abort                  = True
   Deadlock               == Deadlock               = True
-  STMDeadlock            == STMDeadlock            = True
   (UncaughtException e1) == (UncaughtException e2) = show e1 == show e2
   _ == _ = False
 
@@ -455,7 +450,6 @@ instance Ord Condition where
     transform :: Condition -> (Int, Maybe String)
     transform Abort = (1, Nothing)
     transform Deadlock = (2, Nothing)
-    transform STMDeadlock = (3, Nothing)
     transform (UncaughtException e) = (4, Just (show e))
 
 instance NFData Condition where
@@ -469,12 +463,11 @@ isAbort :: Condition -> Bool
 isAbort Abort = True
 isAbort _ = False
 
--- | Check if a condition is a @Deadlock@ or an @STMDeadlock@.
+-- | Check if a condition is a @Deadlock@.
 --
 -- @since 0.9.0.0
 isDeadlock :: Condition -> Bool
 isDeadlock Deadlock = True
-isDeadlock STMDeadlock = True
 isDeadlock _ = False
 
 -- | Check if a condition is an @UncaughtException@

dejafu/Test/DejaFu/Utils.hs

@@ -84,7 +84,6 @@ simplestsBy f = map choose . collect where
 showCondition :: Condition -> String
 showCondition Abort = "[abort]"
 showCondition Deadlock = "[deadlock]"
-showCondition STMDeadlock = "[stm-deadlock]"
 showCondition (UncaughtException exc) = "[" ++ displayException exc ++ "]"
 
 -------------------------------------------------------------------------------