catch _|_ breaks at -O1
Discovered on xmonad-0.12 test failure. Happens on today's -HEAD and ghc-8.0.1-rc1,-rc2
Short example is (needs only base):
-- cat F.hs
module F where
import qualified Control.Exception as C
import System.IO.Unsafe
import qualified Data.List as L
abort :: String -> a
abort x = error $ "xmonad: StackSet: " ++ x
prop_abort x = unsafePerformIO $ C.catch (abort "fail")
(\(C.SomeException e) ->
return $ "xmonad: StackSet: fail" `L.isPrefixOf` show e )
where
_ = x :: Int
Session 1 [ok]:
$ ghci F.hs
GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling F ( F.hs, interpreted )
Ok, modules loaded: F.
*F> prop_abort 1
True
Session 2 [fails]:
$ ghci -O1 -fobject-code F.hs
GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling F ( F.hs, F.o )
Ok, modules loaded: F.
Prelude F> prop_abort 1
*** Exception: xmonad: StackSet: fail
CallStack (from HasCallStack):
error, called at F.hs:9:11 in main:F
I would expect exception to be caught on both cases. Is it unreasonable expectation in light of unsafePerformIO?
Trac metadata
Trac field | Value |
---|---|
Version | 8.0.1-rc2 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | simonpj |
Operating system | |
Architecture |
Edited by rwbarton