run more tests (and add a couple)

Ignore-this: 7b76bd48a7c7d6998505d0503b9d58a1

darcs-hash:20140503021103-1499c-c4f74fe49e61fced376890057daf51609bf6b24b.gz

1 files changed, 36 insertions, 2 deletions

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)