aboutsummaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorAdam Vogt <vogt.adam@gmail.com>2014-05-03 04:11:03 +0200
committerAdam Vogt <vogt.adam@gmail.com>2014-05-03 04:11:03 +0200
commit81a2d0bb75740bf79f6446d38a2aaf6c2e7834f6 (patch)
tree90d04d1ea35e6cd900bbc2daea83d401675a2663 /tests
parentf39af6224f5e3974dbe7d1d5f754ff97ecabaaa2 (diff)
downloadxmonad-81a2d0bb75740bf79f6446d38a2aaf6c2e7834f6.tar.gz
xmonad-81a2d0bb75740bf79f6446d38a2aaf6c2e7834f6.tar.xz
xmonad-81a2d0bb75740bf79f6446d38a2aaf6c2e7834f6.zip
run more tests (and add a couple)
Ignore-this: 7b76bd48a7c7d6998505d0503b9d58a1 darcs-hash:20140503021103-1499c-c4f74fe49e61fced376890057daf51609bf6b24b.gz
Diffstat (limited to 'tests')
-rw-r--r--tests/Instances.hs5
-rw-r--r--tests/Properties.hs35
-rw-r--r--tests/Properties/Screen.hs38
3 files changed, 76 insertions, 2 deletions
diff --git a/tests/Instances.hs b/tests/Instances.hs
index 2f087f8..e52c5ec 100644
--- a/tests/Instances.hs
+++ b/tests/Instances.hs
@@ -11,6 +11,9 @@ import Data.List (nub, genericLength)
import Debug.Trace
+import Graphics.X11 (Rectangle(Rectangle))
+import Control.Applicative
+
--
-- The all important Arbitrary instance for StackSet.
--
@@ -79,6 +82,8 @@ instance Arbitrary NonEmptyWindowsStackSet where
arbitrary =
NonEmptyWindowsStackSet `fmap` (arbitrary `suchThat` (not . null . allWindows))
+instance Arbitrary Rectangle where
+ arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
newtype SizedPositive = SizedPositive Int
diff --git a/tests/Properties.hs b/tests/Properties.hs
index e61d433..466c43a 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -126,6 +126,7 @@ tests =
,("shiftWin: invariant" , property prop_shift_win_I)
,("shiftWin is shift on focus", property prop_shift_win_focus)
,("shiftWin fix current" , property prop_shift_win_fix_current)
+ ,("shiftWin identity", property prop_shift_win_indentity)
,("floating is reversible" , property prop_float_reversible)
,("floating sets geometry" , property prop_float_geometry)
@@ -149,6 +150,40 @@ tests =
,("abort fails", property prop_abort)
,("new fails with abort", property prop_new_abort)
+ ,("point within", property prop_point_within)
+
+ -- tall layout
+
+ ,("tile 1 window fullsize", property prop_tile_fullscreen)
+ ,("tiles never overlap", property prop_tile_non_overlap)
+ ,("split hozizontally", property prop_split_hoziontal)
+ ,("split verticalBy", property prop_splitVertically)
+
+ ,("pure layout tall", property prop_purelayout_tall)
+ ,("send shrink tall", property prop_shrink_tall)
+ ,("send expand tall", property prop_expand_tall)
+ ,("send incmaster tall", property prop_incmaster_tall)
+
+ -- full layout
+
+ ,("pure layout full", property prop_purelayout_full)
+ ,("send message full", property prop_sendmsg_full)
+ ,("describe full", property prop_desc_full)
+
+ ,("describe mirror", property prop_desc_mirror)
+
+ -- resize hints
+ ,("window resize hints: inc", property prop_resize_inc)
+ ,("window resize hints: inc all", property prop_resize_inc_extra)
+ ,("window resize hints: max", property prop_resize_max)
+ ,("window resize hints: max all ", property prop_resize_max_extra)
+
+ ,("window hints fits", property prop_aspect_fits)
+
+
+ ,("pointWithin", property prop_point_within)
+ ,("pointWithin mirror", property prop_point_within_mirror)
+
]
diff --git a/tests/Properties/Screen.hs b/tests/Properties/Screen.hs
index 09a08af..ed9d12b 100644
--- a/tests/Properties/Screen.hs
+++ b/tests/Properties/Screen.hs
@@ -4,10 +4,14 @@ module Properties.Screen where
import Test.QuickCheck
import Instances
+import Control.Applicative
import XMonad.StackSet hiding (filter)
-import XMonad.Operations (applyResizeIncHint, applyMaxSizeHint )
+import XMonad.Operations
import Graphics.X11.Xlib.Types (Dimension)
+import Graphics.X11 (Rectangle(Rectangle))
+import XMonad.Layout
+
prop_screens (x :: T) = n `elem` screens x
where
n = current x
@@ -17,7 +21,7 @@ prop_screens_works (x :: T) = screens x == current x : visible x
------------------------------------------------------------------------
--- Aspect ratios
+-- Hints
prop_resize_inc (NonZero (NonNegative inc_w),NonZero (NonNegative inc_h)) b@(w,h) =
w' `mod` inc_w == 0 && h' `mod` inc_h == 0
@@ -38,3 +42,33 @@ prop_resize_max_extra ((NonNegative inc_w)) b@(w,h) =
(w,h) == (w',h')
where (w',h') = applyMaxSizeHint a b
a = (-inc_w,0::Dimension)-- inc_h)
+
+
+prop_aspect_hint_shrink hint (w,h) = case applyAspectHint hint (w,h) of
+ (w',h') -> w' <= w && h' <= h
+
+
+-- applyAspectHint does nothing when the supplied (x,y) fits
+-- the desired range
+prop_aspect_fits =
+ forAll ((,,,) <$> pos <*> pos <*> pos <*> pos) $ \ (x,y,a,b) ->
+ let f v = applyAspectHint ((x, y+a), (x+b, y)) v
+ overflow = or [ mul x (y+a), mul (x+b) y ]
+ in not overflow ==> f (x,y) == (x,y)
+
+ where pos = choose (0, 65535)
+ mul a b = toInteger (a*b) /= toInteger a * toInteger b
+
+prop_point_within r @ (Rectangle x y w h) =
+ forAll ((,) <$>
+ choose (0, fromIntegral w - 1) <*>
+ choose (0, fromIntegral h - 1)) $
+ \(dx,dy) ->
+ and [ dx > 0, dy > 0,
+ noOverflow x w,
+ noOverflow y h ]
+ ==> pointWithin (x+dx) (y+dy) r
+ where
+ noOverflow a b = (a + fromIntegral (abs b)) > a
+
+prop_point_within_mirror r (x,y) = pointWithin x y r == pointWithin y x (mirrorRect r)