unsafePerformIO duped on multithread if within the same IO thunk
Unlike unsafeDupablePerformIO
, an unsafePerformIO
block is not supposed to be executed more than once when two threads race to evaluate it, and yet the following program detects that the counter is sometimes incremented twice:
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS -O0 -threaded -rtsopts -with-rtsopts=-N #-}
module Main where
import Control.Concurrent
import System.IO.Unsafe
runThreads :: IO () -> IO () -> IO ()
runThreads body1 body2 = do
var1 <- newEmptyMVar
var2 <- newEmptyMVar
_ <- forkIO $ do { !_ <- body1; putMVar var1 () }
_ <- forkIO $ do { !_ <- body2; putMVar var2 () }
takeMVar var1
takeMVar var2
main :: IO ()
main = do
counter <- newMVar (0 :: Int)
let sharedThunk = unsafePerformIO
$ modifyMVar_ counter (return . (+1))
let sharedIO = return sharedThunk
_ <- runThreads sharedIO sharedIO
n <- takeMVar counter
if n == 1 then main else print n
Note that optimizations are turned off, so this isn't due to inlining. In fact, if I inline sharedIO
and write
_ <- runThreads (return sharedThunk) (return sharedThunk)
instead, the problem disappears. So it seems that in order to reproduce the problem, two threads must race to evaluate an IO thunk containing an unsafePerformIO
block; a race to evaluate the unsafePerformIO
block is not sufficient.
Trac metadata
Trac field | Value |
---|---|
Version | 8.0.2-rc2 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |