aboutsummaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Properties.hs6
-rw-r--r--tests/Properties/Layout/Tall.hs8
-rw-r--r--tests/Properties/Screen.hs11
-rw-r--r--tests/Utils.hs10
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
+