diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/Instances.hs | 5 | ||||
| -rw-r--r-- | tests/Properties.hs | 35 | ||||
| -rw-r--r-- | tests/Properties/Screen.hs | 38 |
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) |