mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-31 20:21:51 -07:00
Merge pull request #452 from liskin/pr/hspec
tests: Use hspec as test driver (prep for #407 #430 #440 unit tests); speed up
This commit is contained in:
Tomáš Janoušek
GitHub
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.GridSelect
|
||||
@@ -220,7 +220,7 @@ instance HasColorizer Window where
|
||||
instance HasColorizer String where
|
||||
defaultColorizer = stringColorizer
|
||||
|
||||
instance HasColorizer a where
|
||||
instance {-# OVERLAPPABLE #-} HasColorizer a where
|
||||
defaultColorizer _ isFg =
|
||||
let getColor = if isFg then focusedBorderColor else normalBorderColor
|
||||
in asks $ flip (,) "black" . getColor . config
|
||||
|
||||
@@ -1,4 +1,7 @@
|
||||
{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}
|
||||
#ifdef TESTING
|
||||
{-# OPTIONS_GHC -Wno-duplicate-exports #-}
|
||||
#endif
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.LimitWindows
|
||||
|
||||
106
tests/Main.hs
106
tests/Main.hs
@@ -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" $ 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
|
||||
|
||||
@@ -10,15 +10,17 @@ import XMonad.Actions.SwapWorkspaces
|
||||
|
||||
|
||||
-- Ensures that no "loss of information" can happen from a swap.
|
||||
prop_double_swap (ss :: T) (NonNegative t1) (NonNegative t2) =
|
||||
t1 `tagMember` ss && t2 `tagMember` ss ==>
|
||||
ss == swap (swap ss)
|
||||
where swap = swapWorkspaces t1 t2
|
||||
prop_double_swap (ss :: T) = do
|
||||
t1 <- arbitraryTag ss
|
||||
t2 <- arbitraryTag ss
|
||||
let swap = swapWorkspaces t1 t2
|
||||
return $ ss == swap (swap ss)
|
||||
|
||||
-- Degrade nicely when given invalid data.
|
||||
prop_invalid_swap (ss :: T) (NonNegative t1) (NonNegative t2) =
|
||||
not (t1 `tagMember` ss || t2 `tagMember` ss) ==>
|
||||
ss == swapWorkspaces t1 t2 ss
|
||||
prop_invalid_swap (ss :: T) = do
|
||||
t1 <- arbitrary `suchThat` (not . (`tagMember` ss))
|
||||
t2 <- arbitrary `suchThat` (not . (`tagMember` ss))
|
||||
return $ ss == swapWorkspaces t1 t2 ss
|
||||
|
||||
-- This doesn't pass yet. Probably should.
|
||||
-- prop_half_invalid_swap (ss :: T) (NonNegative t1) (NonNegative t2) =
|
||||
@@ -32,14 +34,15 @@ zipWorkspacesWith f s t = f (workspace $ current s) (workspace $ current t) :
|
||||
zipWith f (hidden s) (hidden t)
|
||||
|
||||
-- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone.
|
||||
prop_swap_only_two (ss :: T) (NonNegative t1) (NonNegative t2) =
|
||||
t1 `tagMember` ss && t2 `tagMember` ss ==>
|
||||
and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss)
|
||||
where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2
|
||||
prop_swap_only_two (ss :: T) = do
|
||||
t1 <- arbitraryTag ss
|
||||
t2 <- arbitraryTag ss
|
||||
let mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2
|
||||
return $ and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss)
|
||||
|
||||
-- swapWithCurrent stays on current
|
||||
prop_swap_with_current (ss :: T) (NonNegative t) =
|
||||
t `tagMember` ss ==>
|
||||
layout before == layout after && stack before == stack after
|
||||
where before = workspace $ current ss
|
||||
after = workspace $ current $ swapWithCurrent t ss
|
||||
prop_swap_with_current (ss :: T) = do
|
||||
t <- arbitraryTag ss
|
||||
let before = workspace $ current ss
|
||||
let after = workspace $ current $ swapWithCurrent t ss
|
||||
return $ layout before == layout after && stack before == stack after
|
||||
|
||||
@@ -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
|
||||
@@ -372,17 +372,38 @@ test-suite properties
|
||||
XPrompt
|
||||
Instances
|
||||
Utils
|
||||
hs-source-dirs: tests
|
||||
XMonad.Actions.CycleWS
|
||||
XMonad.Actions.FocusNth
|
||||
XMonad.Actions.PhysicalScreens
|
||||
XMonad.Actions.RotateSome
|
||||
XMonad.Actions.SwapWorkspaces
|
||||
XMonad.Actions.TagWindows
|
||||
XMonad.Hooks.ManageDocks
|
||||
XMonad.Hooks.WorkspaceHistory
|
||||
XMonad.Layout.LayoutModifier
|
||||
XMonad.Layout.LimitWindows
|
||||
XMonad.Prompt
|
||||
XMonad.Prompt.Shell
|
||||
XMonad.Util.ExtensibleState
|
||||
XMonad.Util.Font
|
||||
XMonad.Util.Image
|
||||
XMonad.Util.PureX
|
||||
XMonad.Util.Run
|
||||
XMonad.Util.Types
|
||||
XMonad.Util.WindowProperties
|
||||
XMonad.Util.WorkspaceCompare
|
||||
XMonad.Util.XSelection
|
||||
XMonad.Util.XUtils
|
||||
hs-source-dirs: tests, .
|
||||
build-depends: base
|
||||
, QuickCheck >= 2
|
||||
, containers
|
||||
, xmonad-contrib
|
||||
, directory
|
||||
, X11>=1.6.1 && < 1.10
|
||||
, containers
|
||||
, directory
|
||||
, hspec >= 2.4.0 && < 3
|
||||
, mtl
|
||||
, process
|
||||
, unix
|
||||
, utf8-string
|
||||
, xmonad >= 0.15 && < 0.16
|
||||
ghc-options: -i.
|
||||
cpp-options: -DTESTING
|
||||
|
||||
Reference in New Issue
Block a user