Merge pull request #48 from mschristiansen/tests

Fix failing tests on GHC 8 and reduce warnings.
This commit is contained in:
Brent Yorgey
2016-11-09 11:06:46 -05:00
committed by GitHub
4 changed files with 20 additions and 15 deletions

View File

@@ -137,7 +137,7 @@ data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable)
instance Message ChangeLayout instance Message ChangeLayout
-- | The layout choice combinator -- | The layout choice combinator
(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a (|||) :: l a -> r a -> Choose l r a
(|||) = Choose L (|||) = Choose L
infixr 5 ||| infixr 5 |||

View File

@@ -477,12 +477,12 @@ insertUp a s = if member a s then s else insert
-- --
-- * otherwise, delete doesn't affect the master. -- * otherwise, delete doesn't affect the master.
-- --
delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd delete :: (Ord a) => a -> StackSet i l a s sd -> StackSet i l a s sd
delete w = sink w . delete' w delete w = sink w . delete' w
-- | Only temporarily remove the window from the stack, thereby not destroying special -- | Only temporarily remove the window from the stack, thereby not destroying special
-- information saved in the 'Stackset' -- information saved in the 'Stackset'
delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd delete' :: (Eq a) => a -> StackSet i l a s sd -> StackSet i l a s sd
delete' w s = s { current = removeFromScreen (current s) delete' w s = s { current = removeFromScreen (current s)
, visible = map removeFromScreen (visible s) , visible = map removeFromScreen (visible s)
, hidden = map removeFromWorkspace (hidden s) } , hidden = map removeFromWorkspace (hidden s) }
@@ -547,7 +547,7 @@ shift n s = maybe s (\w -> shiftWin n w s) (peek s)
-- focused element on that workspace. -- focused element on that workspace.
-- The actual focused workspace doesn't change. If the window is not -- The actual focused workspace doesn't change. If the window is not
-- found in the stackSet, the original stackSet is returned. -- found in the stackSet, the original stackSet is returned.
shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftWin n w s = case findTag w s of shiftWin n w s = case findTag w s of
Just from | n `tagMember` s && n /= from -> go from s Just from | n `tagMember` s && n /= from -> go from s
_ -> s _ -> s

View File

@@ -4,23 +4,27 @@ import XMonad.StackSet hiding (filter)
import qualified Control.Exception.Extensible as C import qualified Control.Exception.Extensible as C
import System.IO.Unsafe import System.IO.Unsafe
import Data.List (isPrefixOf)
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- testing for failure -- testing for failure and help out hpc
--
-- and help out hpc -- Since base 4.9.0.0 `error` appends a stack trace. The tests below
prop_abort x = unsafePerformIO $ C.catch (abort "fail") -- use `isPrefixOf` to only test equality on the error message.
(\(C.SomeException e) -> return $ show e == "xmonad: StackSet: fail" ) --
prop_abort :: Int -> Bool
prop_abort _ = unsafePerformIO $ C.catch (abort "fail") check
where where
_ = x :: Int check (C.SomeException e) =
return $ "xmonad: StackSet: fail" `isPrefixOf` show e
-- new should fail with an abort -- new should fail with an abort
prop_new_abort x = unsafePerformIO $ C.catch f prop_new_abort :: Int -> Bool
(\(C.SomeException e) -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" ) prop_new_abort _ = unsafePerformIO $ C.catch f check
where where
f = new undefined{-layout-} [] [] `seq` return False f = new undefined{-layout-} [] [] `seq` return False
check (C.SomeException e) =
_ = x :: Int return $ "xmonad: StackSet: non-positive argument to StackSet.new" `isPrefixOf` show e
-- TODO: Fix this? -- TODO: Fix this?
-- prop_view_should_fail = view {- with some bogus data -} -- prop_view_should_fail = view {- with some bogus data -}

View File

@@ -31,7 +31,8 @@ build-type: Simple
tested-with: tested-with:
GHC==7.6.3, GHC==7.6.3,
GHC==7.8.4, GHC==7.8.4,
GHC==7.10.2 GHC==7.10.3,
GHC==8.0.1
data-files: man/xmonad.hs, man/xmonad.1, man/xmonad.1.html data-files: man/xmonad.hs, man/xmonad.1, man/xmonad.1.html