twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 03:20:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

tests: Speed up by producing less discarded tests in SwapWorkspaces

Browse Source
This commit is contained in:
Tomas Janousek 2021-01-25 21:31:27 +00:00
parent cd5b1a1015
commit 245dac496b
2 changed files with 20 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
tests/Main.hs
View File

@ -32,7 +32,7 @@ main = hspec $ do
prop "prop_rotate_some_anchors" $ RotateSome.prop_rotate_some_anchors prop "prop_rotate_some_anchors" $ RotateSome.prop_rotate_some_anchors
prop "prop_rotate_some_rotate" $ RotateSome.prop_rotate_some_rotate prop "prop_rotate_some_rotate" $ RotateSome.prop_rotate_some_rotate
prop "prop_rotate_some_focus" $ RotateSome.prop_rotate_some_focus prop "prop_rotate_some_focus" $ RotateSome.prop_rotate_some_focus
context "SwapWorkspaces" $ modifyMaxDiscardRatio (const 100) $ do context "SwapWorkspaces" $ do
prop "prop_double_swap" $ SwapWorkspaces.prop_double_swap prop "prop_double_swap" $ SwapWorkspaces.prop_double_swap
prop "prop_invalid_swap" $ SwapWorkspaces.prop_invalid_swap prop "prop_invalid_swap" $ SwapWorkspaces.prop_invalid_swap
prop "prop_swap_only_two" $ SwapWorkspaces.prop_swap_only_two prop "prop_swap_only_two" $ SwapWorkspaces.prop_swap_only_two

35
tests/SwapWorkspaces.hs
View File

@ -10,15 +10,17 @@ import XMonad.Actions.SwapWorkspaces
-- Ensures that no "loss of information" can happen from a swap. -- Ensures that no "loss of information" can happen from a swap.
prop_double_swap (ss :: T) (NonNegative t1) (NonNegative t2) = prop_double_swap (ss :: T) = do
t1 `tagMember` ss && t2 `tagMember` ss ==> t1 <- arbitraryTag ss
ss == swap (swap ss) t2 <- arbitraryTag ss
where swap = swapWorkspaces t1 t2 let swap = swapWorkspaces t1 t2
return $ ss == swap (swap ss)
-- Degrade nicely when given invalid data. -- Degrade nicely when given invalid data.
prop_invalid_swap (ss :: T) (NonNegative t1) (NonNegative t2) = prop_invalid_swap (ss :: T) = do
not (t1 `tagMember` ss || t2 `tagMember` ss) ==> t1 <- arbitrary `suchThat` (not . (`tagMember` ss))
ss == swapWorkspaces t1 t2 ss t2 <- arbitrary `suchThat` (not . (`tagMember` ss))
return $ ss == swapWorkspaces t1 t2 ss
-- This doesn't pass yet. Probably should. -- This doesn't pass yet. Probably should.
-- prop_half_invalid_swap (ss :: T) (NonNegative t1) (NonNegative t2) = -- 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) zipWith f (hidden s) (hidden t)
-- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone. -- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone.
prop_swap_only_two (ss :: T) (NonNegative t1) (NonNegative t2) = prop_swap_only_two (ss :: T) = do
t1 `tagMember` ss && t2 `tagMember` ss ==> t1 <- arbitraryTag ss
and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss) t2 <- arbitraryTag ss
where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2 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 -- swapWithCurrent stays on current
prop_swap_with_current (ss :: T) (NonNegative t) = prop_swap_with_current (ss :: T) = do
t `tagMember` ss ==> t <- arbitraryTag ss
layout before == layout after && stack before == stack after let before = workspace $ current ss
where before = workspace $ current ss let after = workspace $ current $ swapWithCurrent t ss
after = workspace $ current $ swapWithCurrent t ss return $ layout before == layout after && stack before == stack after