packages feed

quickcheck-state-machine-0.4.1: test/Spec.hs

module Main (main) where

import           Prelude
import           System.Exit
                   (ExitCode(..))
import           System.Process
                   (rawSystem)
import           Test.DocTest
                   (doctest)
import           Test.Tasty
                   (TestTree, defaultMain, testGroup, withResource)
import           Test.Tasty.HUnit
                   (testCase)
import           Test.Tasty.QuickCheck
                   (expectFailure, ioProperty, testProperty,
                   withMaxSuccess)

import           CircularBuffer
import qualified CrudWebserverDb       as WS
import           DieHard
import           Echo
import           MemoryReference
import           TicketDispenser

------------------------------------------------------------------------

tests :: Bool -> TestTree
tests docker0 = testGroup "Tests"
  [ testCase "Doctest Z module" (doctest ["src/Test/StateMachine/Z.hs"])
  , testProperty "Die Hard"
      (expectFailure (withMaxSuccess 1000 prop_dieHard))
  , testGroup "Memory reference"
      [ testProperty "No bug"                             (prop_sequential None)
      , testProperty "Logic bug"           (expectFailure (prop_sequential Logic))
      , testProperty "Race bug sequential"                (prop_sequential Race)
      , testProperty "Race bug parallel"   (expectFailure (prop_parallel   Race))
      ]
  , testGroup "Crud webserver"
      [ webServer docker0 WS.None  8800 "No bug"                       WS.prop_crudWebserverDb
      , webServer docker0 WS.Logic 8801 "Logic bug"   (expectFailure . WS.prop_crudWebserverDb)
      , webServer docker0 WS.Race  8802 "No race bug"                  WS.prop_crudWebserverDb
      , webServer docker0 WS.Race  8803 "Race bug"    (expectFailure . WS.prop_crudWebserverDbParallel)
      ]
  , testGroup "Ticket dispenser"
      [ ticketDispenser "sequential"                   prop_ticketDispenser
      , ticketDispenser "parallel with exclusive lock" (withMaxSuccess 30 .
                                                        prop_ticketDispenserParallelOK)
      , ticketDispenser "parallel with shared lock"    (expectFailure .
                                                        prop_ticketDispenserParallelBad)
      ]
  , testGroup "Circular buffer"
      [ testProperty "`unpropNoSizeCheck`: the first bug is found"
          (expectFailure unpropNoSizeCheck)
      , testProperty "`unpropFullIsEmpty`: the second bug is found"
          (expectFailure unpropFullIsEmpty)
      , testProperty "`unpropBadRem`: the third bug is found"
          (expectFailure unpropBadRem)
      , testProperty "`unpropStillBadRem`: the fourth bug is found"
          (expectFailure unpropStillBadRem)
      , testProperty "`prop_circularBuffer`: the fixed version is correct"
          prop_circularBuffer
      ]
  , testGroup "Echo"
      [ testProperty "sequential"  (ioProperty (prop_echoOK <$> mkEnv))
      , testProperty "parallel ok" (ioProperty (prop_echoParallelOK False <$> mkEnv))
      , testProperty "parallel bad, see issue #218"
          (expectFailure (ioProperty (prop_echoParallelOK True <$> mkEnv)))
      ]
  ]
  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, skipping: " ++ test) (return ())

    ticketDispenser test prop =
      withResource setupLock cleanupLock
        (\ioLock -> testProperty test (ioProperty (prop <$> ioLock)))

------------------------------------------------------------------------

main :: IO ()
main = do
  -- Check if docker is avaiable.
  ec <- rawSystem "docker" ["version"]
  let docker = case ec of
                 ExitSuccess   -> True
                 ExitFailure _ -> False
  defaultMain (tests docker)