Fix failing tests on GHC 8 and reduce warnings.

Fix test failures on GHC 8 for `abort` and `new_abort` caused by `error`
appending the stack trace to the error message (since base
4.9.0.0)[1]. This fixes #36.

An alternative is to use `errorWithoutStackTrace` (new in base 4.9.0.0),
but this then requires use of CPP for backwards compatibility.

Remove type constraints prompting GHC to warn about redundant
constraints.

Tested with 7.6.3, 7.8.4, 7.10.3, 8.0.1 (all on NixOS).

[1] https://hackage.haskell.org/package/base-4.9.0.0/docs/GHC-Stack.html
This commit is contained in:
Mikkel Christiansen 2016-09-23 10:03:46 +02:00
parent 8b055621e9
commit f490ced673
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
-- | 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
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.
--
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
-- | Only temporarily remove the window from the stack, thereby not destroying special
-- 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)
, visible = map removeFromScreen (visible 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.
-- The actual focused workspace doesn't change. If the window is not
-- 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
Just from | n `tagMember` s && n /= from -> go from s
_ -> s

View File

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

View File

@ -31,7 +31,8 @@ build-type: Simple
tested-with:
GHC==7.6.3,
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