#5453: Floating a non-exhaustive case can cause seg-faults
---------------------------------+------------------------------------------
Reporter: simonpj | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.2.1
Keywords: | Testcase:
Blockedby: | Difficulty:
Os: Unknown/Multiple | Blocking:
Architecture: Unknown/Multiple | Failure: None/Unknown
---------------------------------+------------------------------------------
Consider
{{{
{-# LANGUAGE MagicHash #-}
module Main where
import GHC.Exts
data Var = TyVar !Int Bool Bool
| TcTyVar Bool !Int Bool
| Var Bool Bool !Int
deriving (Show)
scrut :: Var -> (Bool, String)
scrut v = (True, case v of
TcTyVar {} -> "OK"
_ -> show v ++ show (case (case v of
TyVar b _ _ -> b
Var _ _ b -> b) of
I# x# -> if x# ==# 7#
then show (I# (x# +# 1#))
else show (I# (x# +# 2#))))
main = putStrLn $ snd (scrut (TcTyVar True 1 False))
}}}
Try this:
{{{
ghc -O -fno-specialise Segfault.hs
./Segfault
}}}
The bug is in the new case-floating machinery. If you compile with
`-dverbose-core2core` you'll see the following after the first float-out
phase:
{{{
Main.scrut =
\ (v_acT :: Main.Var) ->
case case v_acT of _ {
Main.TyVar b_acU ds_dw6 ds_dw7 -> b_acU;
Main.Var ds_dw4 ds_dw5 b_acV -> b_acV
}
of _ { GHC.Types.I# x#_szn ->
(GHC.Types.True,
case v_acT of wild_Xh {
__DEFAULT ->
GHC.Base.augment
@ GHC.Types.Char
(\ (@ b_axY)
(c_axZ [Lbv=OneShot] :: GHC.Types.Char -> b_axY -> b_axY)
(n_ay0 [Lbv=OneShot] :: b_axY) ->
GHC.Base.foldr
@ GHC.Types.Char @ b_axY c_axZ n_ay0 ($cshow_avj v_acT))
(GHC.Show.$fShow[]_$cshow
@ GHC.Types.Char
GHC.Show.$fShowChar
(case case x#_szn of _ {
__DEFAULT -> GHC.Types.False;
7 -> GHC.Types.True
}
of _ {
GHC.Types.False ->
GHC.Show.$fShowInt_$cshow (GHC.Types.I# (GHC.Prim.+#
x#_szn 2));
GHC.Types.True ->
GHC.Show.$fShowInt_$cshow (GHC.Types.I# (GHC.Prim.+#
x#_szn 1))
}));
Main.TcTyVar ds_dwf ds_dwg ds_dwh -> lvl_szP
})
}
}}}
See the way that `case case v_acT` has gotten floated right out? There
are two separate bugs here:
1. It's wrong from a strictness point of view, because it's made `scrut`
strict in `v`
2. It's wrong from a semantics point of view, because the floated-out
case is non-exhaustive, and that's what ultimately leads to the seg fault.
Problem (2) is with `CoreUtils.exprOkForSpeculation`. A non-exhaustive
case is ''not'' ok for speculation!
Problem (1) is with the `AnnCase` case of `SetLevels.lvlExpr`, where we're
testing the wrong expression for ok-for-speculation-nes. Both are quite
easy to fix.
Thanks to Max for identifying this bug.
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/5453>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
