fenv: Add an example program to show problems with forkIO.master
authorNick Bowler <nbowler@draconx.ca>
Wed, 13 Oct 2010 22:38:58 +0000 (13 18:38 -0400)
committerNick Bowler <nbowler@draconx.ca>
Wed, 13 Oct 2010 22:38:58 +0000 (13 18:38 -0400)
Data/Floating/Environment.hs
examples/.gitignore
examples/fenv-race.hs [new file with mode: 0644]

index ccc38d8..11d50cd 100644 (file)
 -- they can be performed later, thus one should be take care not to construct
 -- huge thunks when using this interface.
 --
--- This interface has not been tested in multi-threaded programs.  It might
--- work: more info is needed about GHC's threading support.
+-- Be careful when using these functions in multi-threaded programs.  Due to
+-- an implementation bug (as of GHC 6.12.3), nothing in this module is safe
+-- from races while there are /any/ unbound threads that might potentially
+-- perform /any/ floating point operation whatsoever.
 {-# LANGUAGE CPP, ForeignFunctionInterface, ExistentialQuantification #-}
 {-# OPTIONS_GHC -I. #-}
 module Data.Floating.Environment (
index 22d1940..3f65e5e 100644 (file)
@@ -1 +1,2 @@
 fenv-impure
+fenv-race
diff --git a/examples/fenv-race.hs b/examples/fenv-race.hs
new file mode 100644 (file)
index 0000000..70e15d6
--- /dev/null
@@ -0,0 +1,37 @@
+{-
+ - Copyright (C) 2010 Nick Bowler.
+ -
+ - License BSD2:  2-clause BSD license.  See LICENSE for full terms.
+ - This is free software: you are free to change and redistribute it.
+ - There is NO WARRANTY, to the extent permitted by law.
+ -}
+
+-- | Demonstration of why the functions in "Data.Floating.Environment" are
+-- not safe for use concurrently with unbound threads that perform floating
+-- point operations.
+
+{-# LANGUAGE NoImplicitPrelude #-}
+module Main where
+
+import Data.Floating.Prelude
+import Data.Floating.Environment
+import Control.Concurrent
+import Control.Exception
+
+theThread :: MVar () -> MVar Double -> IO ()
+theThread input output = do
+    takeMVar input
+    evaluate (1/10) >>= putMVar output
+
+main :: IO ()
+main = do
+    input  <- newEmptyMVar
+    output <- newEmptyMVar
+    forkIO $ theThread input output
+    ref <- evaluate (1 / 10)
+    -- This rounding mode should not be visible to the other thread.
+    unsafeSetRoundingMode TowardZero
+    putMVar input ()
+    ret <- takeMVar output
+    -- At this point, the output should equal the reference value.
+    print $ ref == ret