summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDon Stewart <dons@galois.com>2007-09-29 01:57:45 +0200
committerDon Stewart <dons@galois.com>2007-09-29 01:57:45 +0200
commit6aa5765183f8862c429d60112a7118dfa801d016 (patch)
tree9e61c9566f8a88e1d6f9127636b9656765dd1938
parent4b15827018d04c340765e7607c16462ab9237088 (diff)
downloadmetatile-6aa5765183f8862c429d60112a7118dfa801d016.tar
metatile-6aa5765183f8862c429d60112a7118dfa801d016.zip
100% coverage of alternative branches
darcs-hash:20070928235745-cba2c-c8d9bd87100da803d11d00300bfd6486bbc29911
-rw-r--r--StackSet.hs13
-rw-r--r--tests/Properties.hs11
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)