100% coverage of alternative branches

darcs-hash:20070928235745-cba2c-c8d9bd87100da803d11d00300bfd6486bbc29911

2 files changed, 17 insertions, 7 deletions

diff --git a/StackSet.hs b/StackSet.hs
index 4660b80..ff5106c 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -237,12 +237,13 @@ view i s
     -- if it is visible, it is just raised
     = s { current = x, visible = current s : L.deleteBy (equating screen) x (visible s) }
 
-    | Just x <- L.find ((i==).tag)           (hidden  s)
+    | Just x <- L.find ((i==).tag)           (hidden  s) -- must be hidden then
     -- if it was hidden, it is raised on the xine screen currently used
     = s { current = (current s) { workspace = x }
         , hidden = workspace (current s) : L.deleteBy (equating tag) x (hidden s) }
 
-    | otherwise = s -- can't happen?
+--  | otherwise = s -- can't happen: all workspaces are either invalid, current, visible, or hidden
+
   where equating f = \x y -> f x == f y
 
     -- 'Catch'ing this might be hard. Relies on monotonically increasing
@@ -525,10 +526,12 @@ shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s)
 -- found in the stackSet, the original stackSet is returned.
 -- TODO how does this duplicate 'shift's behaviour?
 shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
-shiftWin n w s | from == Nothing                     = s
+shiftWin n w s | from == Nothing                     = s -- not found
                | n `tagMember` s && (Just n) /= from = go
                | otherwise                           = s
-    where go     = on n (insertUp w) . on (fromJust from) (delete' w) $ s
+    where from   = findIndex w s
+
+          go     = on n (insertUp w) . on (fromJust from) (delete' w) $ s
           curtag = tag (workspace (current s))
-          from   = findIndex w s
           on i f = view curtag . f . view i
+
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 138924f..385769e 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -519,6 +519,10 @@ prop_shift_win_focus i (x :: T) =
                           Nothing -> True
                           Just w  -> shiftWin i w x == shift i x
 
+-- shiftWin on a non-existant window is identity
+prop_shift_win_indentity i w (x :: T) =
+    i `tagMember` x && not (w  `member` x) ==> shiftWin i w x == x
+
 -- shiftWin leaves the current screen as it is, if neither i is the tag
 -- of the current workspace nor w on the current workspace
 prop_shift_win_fix_current i w (x :: T) =
@@ -568,6 +572,8 @@ prop_new_abort x = unsafePerformIO $ C.catch f
 
      _ = x :: Int
 
+-- prop_view_should_fail = view {- with some bogus data -}
+
 ------------------------------------------------------------------------
 -- some properties for layouts:
 
@@ -702,8 +708,9 @@ main = do
         ,("lookupTagOnScreen", mytest prop_lookup_current)
 
         -- testing for failure:
-        ,("abort fails", mytest prop_abort)
-        ,("new fails with abort", mytest prop_new_abort)
+        ,("abort fails",            mytest prop_abort)
+        ,("new fails with abort",   mytest prop_new_abort)
+        ,("shiftWin identity",      mytest prop_shift_win_indentity)
 
 {-
         ,("tile 1 window fullsize", mytest prop_tile_fullscreen)