{-# LANGUAGE ScopedTypeVariables #-}
module Main (main) where
import Control.Exception
(catch)
import Prelude
import System.Exit
(ExitCode(..))
import System.Process
(StdStream(CreatePipe), proc, std_out,
waitForProcess, withCreateProcess)
import Test.DocTest
(doctest)
import Test.Tasty
(TestTree, defaultMain, testGroup, withResource)
import Test.Tasty.HUnit
(testCase)
import Test.Tasty.QuickCheck
(expectFailure, testProperty, withMaxSuccess)
import Bookstore as Store
import CircularBuffer
import Cleanup
import qualified CrudWebserverDb as WS
import DieHard
import Echo
import ErrorEncountered
import Hanoi
import IORefs
import MemoryReference
import Mock
import Overflow
-- import ProcessRegistry
import qualified ShrinkingProps
import SQLite
import TicketDispenser
import qualified UnionFind
-- RQlite tests fail, see #14
------------------------------------------------------------------------
tests :: Bool -> TestTree
tests docker0 = testGroup "Tests"
[ testCase "Doctest"
(doctest [ "src/Test/StateMachine/Z.hs"
, "src/Test/StateMachine/Logic.hs"
])
, ShrinkingProps.tests
, testProperty "TowersOfHanoi"
(expectFailure (prop_hanoi 3))
, testProperty "DieHard"
(expectFailure (withMaxSuccess 2000 prop_dieHard))
, testGroup "MemoryReference"
[testProperty "NoBugSeq" (prop_sequential MemoryReference.None)
, testProperty "LogicBug" (expectFailure (prop_sequential Logic))
, testProperty "RaceBugSequential" (prop_sequential Race)
, testProperty "NoBugParallel" (prop_parallel MemoryReference.None)
, testProperty "RaceBugParallel" (expectFailure (prop_parallel Race))
, testProperty "CrashBugParallel" (prop_parallel' Crash)
, testProperty "CrashAndLogicBugParallel"
(expectFailure (withMaxSuccess 10000 (prop_parallel' CrashAndLogic)))
, testProperty "PreconditionFailed" prop_precondition
, testProperty "ExistsCommands" prop_existsCommands
, testProperty "NoBug 1 thread" (prop_nparallel MemoryReference.None 1)
, testProperty "NoBug 2 threads" (prop_nparallel MemoryReference.None 2)
, testProperty "NoBug 3 threads" (withMaxSuccess 80 $ prop_nparallel MemoryReference.None 3)
, testProperty "NoBug 4 threads" (withMaxSuccess 40 $ prop_nparallel MemoryReference.None 4)
, testProperty "RaceBugParalleel 1 thread" (prop_nparallel Race 1)
, testProperty "RaceBugParalleel 2 threads" (expectFailure (prop_nparallel Race 2))
, testProperty "RaceBugParalleel 3 threads" (expectFailure (prop_nparallel Race 3))
, testProperty "RaceBugParalleel 4 threads" (expectFailure (prop_nparallel Race 4))
, testProperty "ShrinkParallelEquivalence" prop_pairs_shrink_parallel_equivalence
, testProperty "ShrinkAndValidateParallelEquivalence" prop_pairs_shrinkAndValidate_equivalence
, testProperty "ShrinkPairsEquialence" prop_pairs_shrink_parallel
]
, testGroup "Overflow"
[ testProperty "2-threads" prop_parallel_overflow
, testProperty "3-threads" $ prop_nparallel_overflow 3
, testProperty "4-threads" $ expectFailure
$ withMaxSuccess 500
$ prop_nparallel_overflow 4
]
, testGroup "Cleanup"
[ testProperty "seqRegularNoOp" $ prop_sequential_clean Regular Cleanup.NoBug NoOp
, testProperty "seqRegular" $ prop_sequential_clean Regular Cleanup.NoBug ReDo
, testProperty "seqRegularExcNoOp"
$ expectFailure $ prop_sequential_clean Regular Cleanup.Exception NoOp
, testProperty "seqRegularExc"
$ expectFailure $ prop_sequential_clean Regular Cleanup.Exception ReDo
, testProperty "seqFilesNoOp" $ prop_sequential_clean Files Cleanup.NoBug NoOp
, testProperty "seqFiles" $ prop_sequential_clean Files Cleanup.NoBug ReDo
, testProperty "seqFilesExcNoOp" $ prop_sequential_clean Files Cleanup.Exception NoOp
, testProperty "seqFilesExc" $ prop_sequential_clean Files Cleanup.Exception ReDo
, testProperty "seqFilesExcAfterNoOp" $ prop_sequential_clean Files Cleanup.ExcAfter NoOp
, testProperty "seqFilesExcAfterReDo" $ prop_sequential_clean Files Cleanup.ExcAfter ReDo
, testProperty "seqEquivNoOp" $ prop_sequential_clean (Eq False) Cleanup.NoBug NoOp
, testProperty "2-threadsRegularExc"
$ expectFailure $ prop_parallel_clean Regular Cleanup.Exception NoOp
, testProperty "2-threadsRegularExc"
$ expectFailure $ prop_parallel_clean Regular Cleanup.Exception ReDo
, testProperty "2-threadsFilesExc"
$ expectFailure $ withMaxSuccess 1000 $ prop_parallel_clean Files Cleanup.Exception ReDo
, testProperty "2-threadsEquivFailingNoOp"
$ expectFailure $ withMaxSuccess 1000 $ prop_parallel_clean (Eq True) Cleanup.NoBug NoOp
, testProperty "3-threadsRegularNoOp" $ prop_nparallel_clean 3 Regular Cleanup.NoBug NoOp
, testProperty "3-threadsRegular"
$ expectFailure $ prop_nparallel_clean 3 Regular Cleanup.NoBug ReDo
, testProperty "3-threadsRegularExc" $ expectFailure
$ prop_nparallel_clean 3 Regular Cleanup.Exception NoOp
, testProperty "3-threadsRegularExc"
$ expectFailure $ prop_nparallel_clean 3 Regular Cleanup.Exception ReDo
, testProperty "3-threadsFilesNoOp" $ prop_nparallel_clean 3 Files Cleanup.NoBug NoOp
, testProperty "3-threadsFiles"
$ expectFailure $ prop_nparallel_clean 3 Files Cleanup.NoBug ReDo
, testProperty "3-threadsFilesExcNoOp" $ prop_nparallel_clean 3 Files Cleanup.Exception NoOp
, testProperty "3-threadsFilesExc"
$ expectFailure $ withMaxSuccess 1000 $ prop_nparallel_clean 3 Files Cleanup.Exception ReDo
, testProperty "3-threadsFilesExcAfter" $ prop_nparallel_clean 3 Files Cleanup.ExcAfter NoOp
, testProperty "3-threadsEquivNoOp" $ prop_nparallel_clean 3 (Eq False) Cleanup.NoBug NoOp
, testProperty "3-threadsEquivFailingNoOp"
$ expectFailure $ withMaxSuccess 1000 $ prop_nparallel_clean 3 (Eq True) Cleanup.NoBug NoOp
]
, testGroup "SQLite"
[ testProperty "Parallel" prop_parallel_sqlite
]
-- Rqlite tests fail, see #14
--, testGroup "Rqlite"
-- [ whenDocker docker0 "rqlite" $ testProperty "parallel" $ withMaxSuccess 10 $ prop_parallel_rqlite (Just Weak)
-- we currently don't add other properties, because they interfere (Tasty runs tests on parallel)
-- , testProperty "sequential" $ withMaxSuccess 10 $ prop_sequential_rqlite (Just Weak)
-- , testProperty "sequential-stale" $ expectFailure $ prop_sequential_rqlite (Just RQlite.None)
-- ]
, testGroup "ErrorEncountered"
[ testProperty "Sequential" prop_error_sequential
, testProperty "Parallel" prop_error_parallel
, testProperty "2-Parallel" $ prop_error_nparallel 2
, testProperty "3-Parallel" $ prop_error_nparallel 3
, testProperty "4-Parallel" $ prop_error_nparallel 4
]
, testGroup "CrudWebserver"
[ webServer docker0 WS.None 8800 "NoBug" WS.prop_crudWebserverDb
, webServer docker0 WS.Logic 8801 "LogicBug" (expectFailure . WS.prop_crudWebserverDb)
, webServer docker0 WS.Race 8802 "NoRaceBug" WS.prop_crudWebserverDb
, webServer docker0 WS.Race 8803 "RaceBug" (expectFailure . WS.prop_crudWebserverDbParallel)
]
, testGroup "Bookstore"
[ dataBase docker0 "NoBug" (Store.prop_bookstore Store.NoBug)
, dataBase docker0 "SqlStatementBug"
$ expectFailure
. withMaxSuccess 500
. Store.prop_bookstore Bug
, dataBase docker0 "InputValidationBug"
$ expectFailure
. withMaxSuccess 500
. Store.prop_bookstore Injection
]
, testGroup "TicketDispenser"
[ testProperty "Sequential" prop_ticketDispenser
, testProperty "ParallelWithExclusiveLock" (withMaxSuccess 30
prop_ticketDispenserParallelOK)
, testProperty "ParallelWithSharedLock" (expectFailure
prop_ticketDispenserParallelBad)
, testProperty "2-ParallelWithExclusiveLock" (prop_ticketDispenserNParallelOK 2)
, testProperty "3-ParallelWithExclusiveLock" (prop_ticketDispenserNParallelOK 3)
, testProperty "4-ParallelWithExclusiveLock" (prop_ticketDispenserNParallelOK 4)
, testProperty "3-ParallelWithSharedLock" (expectFailure $
prop_ticketDispenserNParallelBad 3)
]
, testGroup "Mock"
[ testProperty "sequential" prop_sequential_mock
, testProperty "parallel" prop_parallel_mock
, testProperty "nparallel" prop_nparallel_mock
]
, testGroup "CircularBuffer"
[ testProperty "unpropNoSizeCheck"
(expectFailure (withMaxSuccess 1000 unpropNoSizeCheck))
, testProperty "unpropFullIsEmpty"
(expectFailure (withMaxSuccess 1000 unpropFullIsEmpty))
, testProperty "unpropBadRem"
(expectFailure (withMaxSuccess 1000 unpropBadRem))
, testProperty "unpropStillBadRem"
(expectFailure (withMaxSuccess 1000 unpropStillBadRem))
, testProperty "prop_circularBuffer"
prop_circularBuffer
]
, testGroup "Echo"
[ testProperty "Sequential" prop_echoOK
, testProperty "Parallel" prop_echoParallelOK
, testProperty "2-Parallel" (prop_echoNParallelOK 2)
, testProperty "3-Parallel" (prop_echoNParallelOK 3)
]
-- XXX: The generator function needs to be reimplemented.
-- , testGroup "ProcessRegistry"
-- [ testProperty "Sequential" prop_processRegistry
-- ]
, testGroup "UnionFind"
[ testProperty "Sequential" UnionFind.prop_unionFindSequential ]
, testGroup "Lockstep"
[ testProperty "IORefs_Sequential" prop_IORefs_sequential
]
]
where
webServer docker bug port test prop
| docker = withResource (WS.setup bug WS.connectionString port) WS.cleanup
(const (testProperty test (prop port)))
| otherwise = testCase ("No docker or running on CI, skipping: " ++ test) (return ())
dataBase docker test prop
| docker = withResource Store.setup
Store.cleanup
(\io -> testProperty test (prop (snd <$> io)))
| otherwise = testCase ("No docker, skipping: " ++ test) (return ())
-- Currently unused, see #14
-- whenDocker docker test prop
-- | docker = prop
-- | otherwise = testCase ("No docker, skipping: " ++ test) (return ())
------------------------------------------------------------------------
main :: IO ()
main = do
-- Check if docker is avaiable.
ec <- rawSystemNoStdout "docker" ["version"]
`catch` (\(_ :: IOError) -> return (ExitFailure 127))
let docker = case ec of
ExitSuccess -> True
ExitFailure _ -> False
defaultMain (tests docker)
where
rawSystemNoStdout cmd args =
withCreateProcess
(proc cmd args) { std_out = CreatePipe }
(\_ _ _ -> waitForProcess)