barrucadu/dejafu
1
1
Fork 0
mirror of https://github.com/barrucadu/dejafu.git synced 2024-12-20 03:51:39 +03:00
Code Issues Projects Releases Wiki Activity

Update the deadlocks* predicates to handle STMDeadlock, and add exceptions* predicates

Browse Source
This commit is contained in:
Michael Walker 2015-02-17 05:58:25 +00:00
parent 22a15dfe95
commit 998fdeb833
1 changed files with 20 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
Test/DejaFu.hs
View File

@ -73,6 +73,9 @@ module Test.DejaFu
, deadlocksNever , deadlocksNever
, deadlocksAlways , deadlocksAlways
, deadlocksSometimes , deadlocksSometimes
, exceptionsNever
, exceptionsAlways
, exceptionsSometimes
, alwaysSame , alwaysSame
, notAlwaysSame , notAlwaysSame
, alwaysTrue , alwaysTrue
@ -85,6 +88,7 @@ import Control.Applicative ((<$>))
import Control.Arrow (first) import Control.Arrow (first)
import Control.DeepSeq (NFData(..)) import Control.DeepSeq (NFData(..))
import Control.Monad (when) import Control.Monad (when)
import Data.List (nub)
import Data.List.Extra import Data.List.Extra
import Data.Monoid (mconcat) import Data.Monoid (mconcat)
import Test.DejaFu.Deterministic import Test.DejaFu.Deterministic
@ -182,7 +186,7 @@ runTestIO' pb predicate conc = do
-- | Strip out duplicates -- | Strip out duplicates
uniques :: Eq a => [(a, Trace)] -> [(a, Trace)] uniques :: Eq a => [(a, Trace)] -> [(a, Trace)]
uniques = sortNubBy simplicity uniques = nub . sortNubBy simplicity
-- | Determine which of two failures is simpler, if they are comparable. -- | Determine which of two failures is simpler, if they are comparable.
simplicity :: Eq a => (a, Trace) -> (a, Trace) -> Maybe Ordering simplicity :: Eq a => (a, Trace) -> (a, Trace) -> Maybe Ordering
@ -218,15 +222,27 @@ type Predicate a = [(Either Failure a, Trace)] -> Result a
-- | Check that a computation never deadlocks. -- | Check that a computation never deadlocks.
deadlocksNever :: Predicate a deadlocksNever :: Predicate a
deadlocksNever = alwaysTrue (not . either (==Deadlock) (const False)) deadlocksNever = alwaysTrue (not . either (`elem` [Deadlock, STMDeadlock]) (const False))
-- | Check that a computation always deadlocks. -- | Check that a computation always deadlocks.
deadlocksAlways :: Predicate a deadlocksAlways :: Predicate a
deadlocksAlways = alwaysTrue $ either (==Deadlock) (const False) deadlocksAlways = alwaysTrue $ either (`elem` [Deadlock, STMDeadlock]) (const False)
-- | Check that a computation deadlocks at least once. -- | Check that a computation deadlocks at least once.
deadlocksSometimes :: Predicate a deadlocksSometimes :: Predicate a
deadlocksSometimes = somewhereTrue $ either (==Deadlock) (const False) deadlocksSometimes = somewhereTrue $ either (`elem` [Deadlock, STMDeadlock]) (const False)
-- | Check that a computation never fails with an uncaught exception.
exceptionsNever :: Predicate a
exceptionsNever = alwaysTrue (not . either (==UncaughtException) (const False))
-- | Check that a computation always fails with an uncaught exception.
exceptionsAlways :: Predicate a
exceptionsAlways = alwaysTrue $ either (==UncaughtException) (const False)
-- | Check that a computation fails with an uncaught exception at least once.
exceptionsSometimes :: Predicate a
exceptionsSometimes = somewhereTrue $ either (==UncaughtException) (const False)
-- | Check that the result of a computation is always the same. In -- | Check that the result of a computation is always the same. In
-- particular this means either: (a) it always deadlocks, or (b) the -- particular this means either: (a) it always deadlocks, or (b) the