mirror of
https://github.com/barrucadu/dejafu.git
synced 2024-12-24 22:12:25 +03:00
38 lines
1.7 KiB
Haskell
38 lines
1.7 KiB
Haskell
module Main (main) where
|
|
|
|
import Test.DejaFu
|
|
import System.Exit (exitFailure, exitSuccess)
|
|
|
|
import qualified Tests.Cases as C
|
|
import qualified Tests.Logger as L
|
|
|
|
andM :: (Functor m, Monad m) => [m Bool] -> m Bool
|
|
andM = fmap and . sequence
|
|
|
|
runTests :: IO Bool
|
|
runTests =
|
|
andM [dejafu C.simple2Deadlock ("Simple 2-Deadlock", deadlocksSometimes)
|
|
,dejafu (C.philosophers 2) ("2 Philosophers", deadlocksSometimes)
|
|
,dejafu (C.philosophers 3) ("3 Philosophers", deadlocksSometimes)
|
|
,dejafu (C.philosophers 4) ("4 Philosophers", deadlocksSometimes)
|
|
,dejafu C.thresholdValue ("Threshold Value", notAlwaysSame)
|
|
,dejafu C.forgottenUnlock ("Forgotten Unlock", deadlocksAlways)
|
|
,dejafu C.simple2Race ("Simple 2-Race", notAlwaysSame)
|
|
,dejafu C.raceyStack ("Racey Stack", notAlwaysSame)
|
|
,dejafu C.threadKill ("killThread", deadlocksSometimes)
|
|
,dejafu C.threadKillMask ("killThread+mask 1", deadlocksNever)
|
|
,dejafu C.threadKillUmask ("killThread+mask 2", deadlocksSometimes)
|
|
,dejafu C.stmAtomic ("STM Atomicity", alwaysTrue (\r -> fmap (`elem` [0,2]) r == Right True))
|
|
,dejafu C.stmRetry ("STM Retry", alwaysSame)
|
|
,dejafu C.stmOrElse ("STM orElse", alwaysSame)
|
|
,dejafu C.stmExc ("STM Exceptions", alwaysSame)
|
|
,dejafu C.excNest ("Nested Excs", alwaysSame)
|
|
,dejafus L.badLogger [("Logger (Valid)", L.validResult)
|
|
,("Logger (Good)", L.isGood)
|
|
,("Logger (Bad", L.isBad)]]
|
|
|
|
main :: IO ()
|
|
main = do
|
|
success <- runTests
|
|
if success then exitSuccess else exitFailure
|