[commit: ghc] master: Fix deadlock bug when mkFastStringWith is duplicated (f088c2d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f088c2d42aaa38b32482ea8c4324786123835e62/ghc

>---------------------------------------------------------------

commit f088c2d42aaa38b32482ea8c4324786123835e62
Author: Zejun Wu <watashi at fb.com>
Date:   Thu Nov 22 11:49:51 2018 -0500

    Fix deadlock bug when mkFastStringWith is duplicated
    
    In D5211, we use `withMVar` to guard writes to the same segment, this
    is unsafe to be duplicated. It can lead to deadlock if it is only run
    partially and `putMVar` is not called after `takeMVar`.
    
    Test Plan:
      ./validate
    
    We used to see deadlock when building stackage without this fix, and it
    no longer happens.
    
    Reviewers: simonmar, bgamari
    
    Reviewed By: simonmar
    
    Subscribers: rwbarton, carter
    
    Differential Revision: https://phabricator.haskell.org/D5349


>---------------------------------------------------------------

f088c2d42aaa38b32482ea8c4324786123835e62
 compiler/utils/FastFunctions.hs | 2 +-
 compiler/utils/FastString.hs    | 6 ++++--
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/compiler/utils/FastFunctions.hs b/compiler/utils/FastFunctions.hs
index be3f3cb..9a09bb7 100644
--- a/compiler/utils/FastFunctions.hs
+++ b/compiler/utils/FastFunctions.hs
@@ -15,7 +15,7 @@ import GhcPrelude ()
 import GHC.Exts
 import GHC.IO   (IO(..))
 
--- Just like unsafePerformIO, but we inline it.
+-- Just like unsafeDupablePerformIO, but we inline it.
 {-# INLINE inlinePerformIO #-}
 inlinePerformIO :: IO a -> a
 inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs
index c53eff1..f9fbeb0 100644
--- a/compiler/utils/FastString.hs
+++ b/compiler/utils/FastString.hs
@@ -114,14 +114,13 @@ import qualified Data.ByteString.Unsafe   as BS
 import Foreign.C
 import GHC.Exts
 import System.IO
-import System.IO.Unsafe ( unsafePerformIO )
 import Data.Data
 import Data.IORef
 import Data.Maybe       ( isJust )
 import Data.Char
 import Data.Semigroup as Semi
 
-import GHC.IO           ( IO(..), unIO, unsafeDupablePerformIO )
+import GHC.IO
 
 import Foreign
 
@@ -400,6 +399,9 @@ mkFastStringWith mk_fs !ptr !len = do
   case res of
     Just found -> return found
     Nothing -> do
+      -- The withMVar below is not dupable. It can lead to deadlock if it is
+      -- only run partially and putMVar is not called after takeMVar.
+      noDuplicate
       n <- get_uid
       new_fs <- mk_fs n
       withMVar lock $ \_ -> insert new_fs