diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/Properties.hs | 6 | ||||
| -rw-r--r-- | tests/Properties/Layout/Tall.hs | 8 | ||||
| -rw-r--r-- | tests/Properties/Screen.hs | 11 | ||||
| -rw-r--r-- | tests/Utils.hs | 10 |
4 files changed, 21 insertions, 14 deletions
diff --git a/tests/Properties.hs b/tests/Properties.hs index b5762d7..e8c4e5a 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -35,7 +35,7 @@ main = do Success {} -> return True _ -> return False perform (s, t) = printf "%-35s: " s >> qc t - n <- length . filter not ok <$> mapM perform tests + n <- length . filter not <$> mapM perform tests unless (n == 0) (error (show n ++ " test(s) failed")) @@ -167,8 +167,8 @@ tests = ,("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) + ,("split horizontal", property prop_split_horizontal) + ,("split vertical", property prop_split_vertical) ,("pure layout tall", property prop_purelayout_tall) ,("send shrink tall", property prop_shrink_tall) diff --git a/tests/Properties/Layout/Tall.hs b/tests/Properties/Layout/Tall.hs index 7464184..2f836ef 100644 --- a/tests/Properties/Layout/Tall.hs +++ b/tests/Properties/Layout/Tall.hs @@ -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 diff --git a/tests/Properties/Screen.hs b/tests/Properties/Screen.hs index ed9d12b..cf76252 100644 --- a/tests/Properties/Screen.hs +++ b/tests/Properties/Screen.hs @@ -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) diff --git a/tests/Utils.hs b/tests/Utils.hs index 2d9df81..e3eef0f 100644 --- a/tests/Utils.hs +++ b/tests/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RankNTypes #-} module Utils where import XMonad.StackSet hiding (filter) @@ -35,5 +36,12 @@ applyN Nothing f v = v applyN (Just 0) f v = v applyN (Just n) f v = applyN (Just $ n-1) f (f v) - tags x = map tag $ workspaces x + + +-- | noOverflows op a b is True if @a `op` fromIntegral b@ overflows (or +-- otherwise gives the same answer when done using Integer +noOverflows :: (Integral b, Integral c) => + (forall a. Integral a => a -> a -> a) -> b -> c -> Bool +noOverflows op a b = toInteger (a `op` fromIntegral b) == toInteger a `op` toInteger b + |