test lookupWorkspace more deeply

darcs-hash:20070930073822-cba2c-7b661e5bdbdcf99b64f785897af2ecc4278471ea

1 files changed, 10 insertions, 0 deletions

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)