X.L.NoBorders: Add unit test for multihead floats

This commit is contained in:
Tomas Janousek 2021-01-26 22:17:11 +00:00
parent 9cff824a24
commit 48156cafb8
3 changed files with 78 additions and 0 deletions

View File

@ -4,6 +4,7 @@ import Test.Hspec
import Test.Hspec.QuickCheck import Test.Hspec.QuickCheck
import qualified ManageDocks import qualified ManageDocks
import qualified NoBorders
import qualified RotateSome import qualified RotateSome
import qualified Selective import qualified Selective
import qualified SwapWorkspaces import qualified SwapWorkspaces
@ -41,3 +42,4 @@ main = hspec $ do
prop "prop_split" $ XPrompt.prop_split prop "prop_split" $ XPrompt.prop_split
prop "prop_spliInSubListsAt" $ XPrompt.prop_spliInSubListsAt prop "prop_spliInSubListsAt" $ XPrompt.prop_spliInSubListsAt
prop "prop_skipGetLastWord" $ XPrompt.prop_skipGetLastWord prop "prop_skipGetLastWord" $ XPrompt.prop_skipGetLastWord
context "NoBorders" $ NoBorders.spec

74
tests/NoBorders.hs Normal file
View File

@ -0,0 +1,74 @@
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wall #-}
module NoBorders where
import Test.Hspec
import qualified Data.Map as M
import XMonad hiding (Screen)
import qualified XMonad.Layout.NoBorders as NB
import XMonad.StackSet
spec :: Spec
spec = do
describe "dualhead, fullscreen float on each" $ do
let s1 = differentiate [1]
let s2 = differentiate [2]
let floats = [(1, rrFull), (2, rrFull)]
let ws = wsDualHead s1 s2 floats
context "Ambiguity(Never)" $ do
let amb = NB.Never
it "removes border on current screen" $ do
NB.hiddens amb ws r1 s1 [] `shouldBe` [1]
NB.hiddens amb ws r3 s1 [] `shouldBe` [1]
it "removes border on visible screen" $ do
NB.hiddens amb ws r2 s2 [] `shouldBe` [2]
NB.hiddens amb ws r4 s2 [] `shouldBe` [2]
context "Ambiguity(OnlyScreenFloat)" $ do
let amb = NB.OnlyScreenFloat
it "removes border on current screen" $ do
NB.hiddens amb ws r1 s1 [] `shouldBe` [1]
NB.hiddens amb ws r3 s1 [] `shouldBe` [1]
it "removes border on visible screen" $ do
NB.hiddens amb ws r2 s2 [] `shouldBe` [2]
NB.hiddens amb ws r4 s2 [] `shouldBe` [2]
context "Ambiguity(OnlyLayoutFloat)" $ do
let amb = NB.OnlyLayoutFloat
it "removes border on current screen" $ do
NB.hiddens amb ws r1 s1 [] `shouldBe` [1]
it "removes border on visible screen" $ do
NB.hiddens amb ws r2 s2 [] `shouldBe` [2]
-- +------+------+
-- | r1 | r2 |
-- | | |
-- |+----+|+----+|
-- || r3 ||| r4 ||
-- |+----+|+----+|
-- +------+------+
r1, r2, r3, r4 :: Rectangle
r1 = Rectangle 0 0 100 100
r2 = Rectangle 100 0 100 100
r3 = Rectangle 10 10 80 80
r4 = Rectangle 110 10 80 80
rrFull :: RationalRect
rrFull = RationalRect 0 0 1 1
-- | Current screen @r1@ with window stack @w1@,
-- visible screen @r2@ with ws @w2@,
-- no hidden screens, maybe some floats.
wsDualHead :: Maybe (Stack Window) -> Maybe (Stack Window)
-> [(Window, RationalRect)] -> WindowSet
wsDualHead w1 w2 f = StackSet{..}
where
current = mkScreen 1 r1 w1; visible = [mkScreen 2 r2 w2]; hidden = []
floating = M.fromList f
mkScreen :: ScreenId -> Rectangle -> Maybe (Stack Window)
-> Screen WorkspaceId l Window ScreenId ScreenDetail
mkScreen i r s = Screen{ workspace = w, screen = i, screenDetail = sd }
where
w = Workspace{ tag = show i, layout = undefined, stack = s }
sd = SD{ screenRect = r }

View File

@ -366,6 +366,7 @@ test-suite tests
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Main.hs main-is: Main.hs
other-modules: ManageDocks other-modules: ManageDocks
NoBorders
RotateSome RotateSome
Selective Selective
SwapWorkspaces SwapWorkspaces
@ -382,6 +383,7 @@ test-suite tests
XMonad.Hooks.WorkspaceHistory XMonad.Hooks.WorkspaceHistory
XMonad.Layout.LayoutModifier XMonad.Layout.LayoutModifier
XMonad.Layout.LimitWindows XMonad.Layout.LimitWindows
XMonad.Layout.NoBorders
XMonad.Prompt XMonad.Prompt
XMonad.Prompt.Shell XMonad.Prompt.Shell
XMonad.Util.ExtensibleState XMonad.Util.ExtensibleState