make the check for overflow cleaner

This commit is contained in:
Adam Vogt
2014-05-07 02:49:30 +00:00
parent 16c0cb9a33
commit f03d2cdf74
4 changed files with 21 additions and 14 deletions

View File

@@ -28,7 +28,8 @@ prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster w
pct = 3 % 100
-- splitting horizontally yields sensible results
prop_split_hoziontal (NonNegative n) x =
prop_split_horizontal (NonNegative n) x =
(noOverflows (+) (rect_x x) (rect_width x)) ==>
sum (map rect_width xs) == rect_width x
&&
all (== rect_height x) (map rect_height xs)
@@ -38,9 +39,8 @@ prop_split_hoziontal (NonNegative n) x =
where
xs = splitHorizontally n x
-- splitting horizontally yields sensible results
prop_splitVertically (r :: Rational) x =
-- splitting vertically yields sensible results
prop_split_vertical (r :: Rational) x =
rect_x x == rect_x a && rect_x x == rect_x b
&&
rect_width x == rect_width a && rect_width x == rect_width b

View File

@@ -1,6 +1,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Properties.Screen where
import Utils
import Test.QuickCheck
import Instances
@@ -53,8 +54,8 @@ prop_aspect_hint_shrink hint (w,h) = case applyAspectHint hint (w,h) of
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)
in and [ noOverflows (*) x (y+a), noOverflows (*) (x+b) y ]
==> f (x,y) == (x,y)
where pos = choose (0, 65535)
mul a b = toInteger (a*b) /= toInteger a * toInteger b
@@ -65,10 +66,8 @@ prop_point_within r @ (Rectangle x y w h) =
choose (0, fromIntegral h - 1)) $
\(dx,dy) ->
and [ dx > 0, dy > 0,
noOverflow x w,
noOverflow y h ]
noOverflows (\ a b -> a + abs b) x w,
noOverflows (\ a b -> a + abs b) 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)