8.2.1 regression: heap corruption after safe foreign calls
Test case: (compile with ghc 8.2.1 and -threaded option)
module Main where
import Control.Concurrent
import Control.Monad
import Data.Word
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
foreign import ccall safe "test"
c_test :: Ptr Word32 -> IO ()
main :: IO ()
main = do
replicateM_ 1000 $ threadDelay 1000
_ <- forkIO $ forever $ threadDelay 100
allocaBytes 4 $ \p -> forever $ do
c_test p
x <- peek p
unless (x == 0xDEADBEEF) $ putStrLn "value mismatch"
void test(unsigned int *buf) {
*buf = 0xDEADBEEF;
}
On my machine, it detects a few value mismatches before crashing with sigsegv.
$ time ./.stack-work/install/x86_64-linux-nopie/nightly-2017-10-10/8.2.1/bin/bug
value mismatch
value mismatch
value mismatch
value mismatch
zsh: segmentation fault (core dumped) ./.stack-work/install/x86_64-linux-nopie/nightly-2017-10-10/8.2.1/bin/bug
./.stack-work/install/x86_64-linux-nopie/nightly-2017-10-10/8.2.1/bin/bug 2.11s user 0.25s system 66% cpu 3.543 total
I believe this is what is causing crashes in xmobar. See discussion: https://github.com/jaor/xmobar/issues/310. Note that the crash in xmobar still happens without -threaded option, while this example only breaks when compiled with -threaded.
Trac metadata
Trac field | Value |
---|---|
Version | 8.2.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | highest |
Resolution | Unresolved |
Component | Runtime System |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |