From 80f6b60b4164c6217d1d4ac8ae1f38b88fdf05e6 Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Sun, 30 Sep 2007 09:38:22 +0200 Subject: test lookupWorkspace more deeply darcs-hash:20070930073822-cba2c-7b661e5bdbdcf99b64f785897af2ecc4278471ea --- tests/Properties.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'tests') diff --git a/tests/Properties.hs b/tests/Properties.hs index 385769e..4c7c2be 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -555,6 +555,15 @@ prop_lookup_current (x :: T) = lookupWorkspace scr x == Just tg where (Screen (Workspace tg _ _) scr _) = current x +-- looking at a visible tag +prop_lookup_visible (x :: T) = + visible x /= [] ==> + fromJust (lookupWorkspace scr x) `elem` tags + where + tags = [ tag (workspace y) | y <- visible x ] + scr = last [ screen y | y <- visible x ] + + -- --------------------------------------------------------------------- -- testing for failure @@ -706,6 +715,7 @@ main = do ,("screens includes current", mytest prop_screens) ,("differentiate works", mytest prop_differentiate) ,("lookupTagOnScreen", mytest prop_lookup_current) + ,("lookupTagOnVisbleScreen", mytest prop_lookup_visible) -- testing for failure: ,("abort fails", mytest prop_abort) -- cgit v1.2.3