Is this a concurrency bug in base?

[Simon Peyton-Jones]

Did you try 7.2?  As I mentioned, the issue should have gone away entirely because there is no shared cache any more

Simon

From: glasgow-haskell-users-bounces at haskell.org [mailto:glasgow-haskell-users-bounces at haskell.org] On Behalf Of Jean-Marie Gaillourdet
Sent: 12 October 2011 07:19
To: wagnerdm at seas.upenn.edu; Daniel Fischer
Cc: glasgow-haskell-users at haskell.org
Subject: Re: Is this a concurrency bug in base?

Hi,

I've continued my search for a proper workaround. Again, I did find some unexpected results. See below.

On 09.10.2011, at 17:56, wagnerdm at seas.upenn.edu wrote:

> Quoting Jean-Marie Gaillourdet <jmg at gaillourdet.net>:
>
>> That sounds plausible. Do you see any workaround? Perhaps repeatedly evaluating typeOf?
>
> If there's a concurrency bug, surely the workaround is to protect calls to the non-thread-safe function with a lock.
>
>  typeOfWorkaround lock v = do
>      () <- takeMVar lock
>      x <- evaluate (typeOf v)
>      putMVar lock ()
>      return x
>
> ~d

This is my previous program with your workaround, it is also attached as TypeRepEqLock.hs

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Typeable
import System.IO.Unsafe

main :: IO ()
main =
do { fin1 <- newEmptyMVar
  ; fin2 <- newEmptyMVar

  ; forkIO $ typeOf' () >>= putMVar fin1
  ; forkIO $ typeOf' () >>= putMVar fin2

  ; t1 <- takeMVar fin1
  ; t2 <- takeMVar fin2
  ; if (t1 /= t2)
      then putStrLn $ "typeOf " ++ show t1 ++ " /= typeOf " ++ show t2
      else putStrLn "Ok"
  }


{-# NOINLINE lock #-}
lock :: MVar ()
lock = unsafePerformIO $ newMVar ()

-- Ugly workaround to http://hackage.haskell.org/trac/ghc/ticket/5540
typeOf' :: Typeable a => a -> IO TypeRep
typeOf' x =
do { () <- takeMVar lock
  ; t <- evaluate $ typeOf x
  ; putMVar lock ()
  ; return t
  }


Compile and execute:

$ ghc-7.0.3 -threaded -rtsopts TypeRepEqLock.hs
<snip>
$ while true ; do ./TypeRepEqLock +RTS -N ; done
Ok
Ok
Ok
Ok
Ok
Ok
Ok
Ok
Ok
TypeRepEqLock: thread blocked indefinitely in an MVar operation
Ok
Ok
Ok
^C^C

I'm sorry but I don't see how this program could ever deadlock, unless there is some more locking in typeOf and (==) on TypeReps.

On the other side, my admittedly ugly workaround works fine for hours and hours.

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Typeable

main :: IO ()
main =
do { fin1 <- newEmptyMVar
  ; fin2 <- newEmptyMVar

  ; forkIO $ return (typeOf' ()) >>= evaluate >>= putMVar fin1
  ; forkIO $ return (typeOf' ()) >>= evaluate >>= putMVar fin2

  ; t1 <- takeMVar fin1
  ; t2 <- takeMVar fin2
  ; if (t1 /= t2)
      then putStrLn $ "typeOf " ++ show t1 ++ " /= typeOf " ++ show t2
      else putStrLn "Ok"
  }

typeOf' val
  | t1 == t2 = t1
  | otherwise = typeOf' val
where
  t1 = typeOf'' val
  t2 = typeOf''' val
{-# NOINLINE typeOf' #-}


typeOf'' x = typeOf x
{-# NOINLINE typeOf'' #-}
typeOf''' x = typeOf x
{-# NOINLINE typeOf''' #-}


$ ghc-7.0.3 -threaded -rtsopts TypeRepEq.hs
<snip>
$ while true ; do ./TypeRepEq +RTS -N ; done
Ok
Ok
Ok
Ok
Ok
Ok
…

Any hints how to avoid the "thread blocked indefinitely in an MVar operation" exception?

Cheers,
Jean

_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users at haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/glasgow-haskell-users/attachments/20111012/f13480d2/attachment.htm>