tests: Use hspec as test driver

My main motivation here is that I'd like to add some unit tests (as
opposed to testing everything using QuickCheck properties), but there
are other benefits: it's now easier to run a subset of tests -- the
command-line interface is more powerful.

Also, rename the test-suite to "tests" as it's no longer limited to
properties.
This commit is contained in:
Tomas Janousek 2021-01-25 21:05:57 +00:00
parent 320fe8c537
commit cd5b1a1015
2 changed files with 37 additions and 72 deletions

View File

@ -1,79 +1,43 @@
module Main where
import Test.QuickCheck
import System.Environment
import Text.Printf
import Control.Monad
import Test.Hspec
import Test.Hspec.QuickCheck
import qualified ManageDocks
import qualified RotateSome
import qualified Selective
import qualified SwapWorkspaces
import qualified XPrompt
main :: IO ()
main = do
arg <- fmap (drop 1) getArgs
let n = if null arg then 100 else read $ head arg
args = stdArgs { maxSuccess = n, maxSize = 100, maxDiscardRatio = 100 }
qc t = do
c <- quickCheckWithResult args t
case c of
Success{} -> return True
_ -> return False
perform (s, t) = printf "%-35s: " s >> qc t
nFailed <- length . filter not <$> mapM perform tests
unless (nFailed == 0) (error (show nFailed ++ " test(s) failed"))
tests :: [(String, Property)]
tests =
[ ("ManageDocks.prop_r2c_c2r" , property ManageDocks.prop_r2c_c2r)
, ("ManageDocks.prop_c2r_r2c" , property ManageDocks.prop_c2r_r2c)
, ("Selective.prop_select_length", property Selective.prop_select_length)
, ("Selective.prop_update_idem" , property Selective.prop_update_idem)
, ("Selective.prop_select_master", property Selective.prop_select_master)
, ("Selective.prop_select_focus" , property Selective.prop_select_focus)
, ( "Selective.prop_select_increasing"
, property Selective.prop_select_increasing
)
, ( "Selective.prop_select_two_consec"
, property Selective.prop_select_two_consec
)
, ("Selective.prop_update_nm" , property Selective.prop_update_nm)
, ("Selective.prop_update_start" , property Selective.prop_update_start)
, ("Selective.prop_update_nr" , property Selective.prop_update_nr)
, ("Selective.prop_update_focus_up", property Selective.prop_update_focus_up)
, ( "Selective.prop_update_focus_down"
, property Selective.prop_update_focus_down
)
, ( "RotateSome.prop_rotate_some_length"
, property RotateSome.prop_rotate_some_length
)
, ( "RotateSome.prop_rotate_some_cycle"
, property RotateSome.prop_rotate_some_cycle
)
, ( "RotateSome.prop_rotate_some_anchors"
, property RotateSome.prop_rotate_some_anchors
)
, ( "RotateSome.prop_rotate_some_rotate"
, property RotateSome.prop_rotate_some_rotate
)
, ( "RotateSome.prop_rotate_some_focus"
, property RotateSome.prop_rotate_some_focus
)
, ( "SwapWorkspaces.prop_double_swap"
, property SwapWorkspaces.prop_double_swap
)
, ( "SwapWorkspaces.prop_invalid_swap"
, property SwapWorkspaces.prop_invalid_swap
)
, ( "SwapWorkspaces.prop_swap_only_two"
, property SwapWorkspaces.prop_swap_only_two
)
, ( "SwapWorkspaces.prop_swap_with_current"
, property SwapWorkspaces.prop_swap_with_current
)
, ("XPrompt.prop_split" , property XPrompt.prop_split)
, ("XPrompt.prop_spliInSubListsAt", property XPrompt.prop_spliInSubListsAt)
, ("XPrompt.prop_skipGetLastWord" , property XPrompt.prop_skipGetLastWord)
]
main = hspec $ do
context "ManageDocks" $ do
prop "prop_r2c_c2r" $ ManageDocks.prop_r2c_c2r
prop "prop_c2r_r2c" $ ManageDocks.prop_c2r_r2c
context "Selective" $ do
prop "prop_select_length" $ Selective.prop_select_length
prop "prop_update_idem" $ Selective.prop_update_idem
prop "prop_select_master" $ Selective.prop_select_master
prop "prop_select_focus" $ Selective.prop_select_focus
prop "prop_select_increasing" $ Selective.prop_select_increasing
prop "prop_select_two_consec" $ Selective.prop_select_two_consec
prop "prop_update_nm" $ Selective.prop_update_nm
prop "prop_update_start" $ Selective.prop_update_start
prop "prop_update_nr" $ Selective.prop_update_nr
prop "prop_update_focus_up" $ Selective.prop_update_focus_up
prop "prop_update_focus_down" $ Selective.prop_update_focus_down
context "RotateSome" $ do
prop "prop_rotate_some_length" $ RotateSome.prop_rotate_some_length
prop "prop_rotate_some_cycle" $ RotateSome.prop_rotate_some_cycle
prop "prop_rotate_some_anchors" $ RotateSome.prop_rotate_some_anchors
prop "prop_rotate_some_rotate" $ RotateSome.prop_rotate_some_rotate
prop "prop_rotate_some_focus" $ RotateSome.prop_rotate_some_focus
context "SwapWorkspaces" $ modifyMaxDiscardRatio (const 100) $ do
prop "prop_double_swap" $ SwapWorkspaces.prop_double_swap
prop "prop_invalid_swap" $ SwapWorkspaces.prop_invalid_swap
prop "prop_swap_only_two" $ SwapWorkspaces.prop_swap_only_two
prop "prop_swap_with_current" $ SwapWorkspaces.prop_swap_with_current
context "XPrompt" $ do
prop "prop_split" $ XPrompt.prop_split
prop "prop_spliInSubListsAt" $ XPrompt.prop_spliInSubListsAt
prop "prop_skipGetLastWord" $ XPrompt.prop_skipGetLastWord

View File

@ -362,7 +362,7 @@ library
XMonad.Util.XSelection
XMonad.Util.XUtils
test-suite properties
test-suite tests
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules: ManageDocks
@ -400,6 +400,7 @@ test-suite properties
, X11>=1.6.1 && < 1.10
, containers
, directory
, hspec >= 2.4.0 && < 3
, mtl
, process
, unix