diff --git a/dejafu-tests/lib/Integration/SingleThreaded.hs b/dejafu-tests/lib/Integration/SingleThreaded.hs index eca0a28..9c93a88 100644 --- a/dejafu-tests/lib/Integration/SingleThreaded.hs +++ b/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 diff --git a/dejafu-tests/lib/Unit/Predicates.hs b/dejafu-tests/lib/Unit/Predicates.hs index cc04b49..eb8856d 100644 --- a/dejafu-tests/lib/Unit/Predicates.hs +++ b/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] ] diff --git a/dejafu-tests/lib/Unit/Properties.hs b/dejafu-tests/lib/Unit/Properties.hs index 27d3e53..e46856e 100644 --- a/dejafu-tests/lib/Unit/Properties.hs +++ b/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 diff --git a/dejafu/Test/DejaFu.hs b/dejafu/Test/DejaFu.hs index fe6828e..cb827b4 100644 --- a/dejafu/Test/DejaFu.hs +++ b/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 diff --git a/dejafu/Test/DejaFu/Conc/Internal.hs b/dejafu/Test/DejaFu/Conc/Internal.hs index f72fc5e..4a552fc 100755 --- a/dejafu/Test/DejaFu/Conc/Internal.hs +++ b/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' diff --git a/dejafu/Test/DejaFu/Types.hs b/dejafu/Test/DejaFu/Types.hs index 303d40d..120d971 100644 --- a/dejafu/Test/DejaFu/Types.hs +++ b/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@ diff --git a/dejafu/Test/DejaFu/Utils.hs b/dejafu/Test/DejaFu/Utils.hs index ee8c1d7..23c667f 100644 --- a/dejafu/Test/DejaFu/Utils.hs +++ b/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 ++ "]" -------------------------------------------------------------------------------