dejafu/tests/Tests.hs

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