[commit: ghc] master: base: Have the argument of mask restore the state. (2b25a58)

[git at git.haskell.org]

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

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

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

commit 2b25a589ae8f6364bf086b4878f5ec26954931d3
Author: Facundo Domínguez <facundo.dominguez at tweag.io>
Date:   Mon Oct 19 18:16:55 2015 +0200

    base: Have the argument of mask restore the state.
    
    The implementation of `mask` and `uninterruptibleMask` assumed so far
    that the restore argument would be called in a context with the same
    masking state as that set by `mask` or `uninterruptibleMask`.
    
    This patch has the restore argument restore the masking, whatever the
    current masking state is.
    
    Test Plan: validate
    
    Reviewers: simonmar, hvr, austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie, qnikst
    
    Differential Revision: https://phabricator.haskell.org/D1327
    
    GHC Trac Issues: #10149


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

2b25a589ae8f6364bf086b4878f5ec26954931d3
 libraries/base/GHC/IO.hs           |  7 ++++---
 libraries/base/changelog.md        |  3 +++
 libraries/base/tests/T10149.hs     | 19 +++++++++++++++++++
 libraries/base/tests/T10149.stdout |  4 ++++
 libraries/base/tests/all.T         |  1 +
 5 files changed, 31 insertions(+), 3 deletions(-)

diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs
index 231d110..e41a35d 100644
--- a/libraries/base/GHC/IO.hs
+++ b/libraries/base/GHC/IO.hs
@@ -452,8 +452,9 @@ mask_ io = mask $ \_ -> io
 mask io = do
   b <- getMaskingState
   case b of
-    Unmasked -> block $ io unblock
-    _        -> io id
+    Unmasked              -> block $ io unblock
+    MaskedInterruptible   -> io block
+    MaskedUninterruptible -> io blockUninterruptible
 
 uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io
 
@@ -462,7 +463,7 @@ uninterruptibleMask io = do
   case b of
     Unmasked              -> blockUninterruptible $ io unblock
     MaskedInterruptible   -> blockUninterruptible $ io block
-    MaskedUninterruptible -> io id
+    MaskedUninterruptible -> io blockUninterruptible
 
 bracket
         :: IO a         -- ^ computation to run first (\"acquire resource\")
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index ff03562..97a4971 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -2,6 +2,9 @@
 
 ## 4.8.2.0  *TBA*
 
+  * The restore operation provided by `mask` and `uninterruptibleMask` now
+    restores the previous masking state whatever the current masking state is.
+
   * Bundled with GHC 7.12.1
 
   * `Alt`, `Dual`, `First`, `Last`, `Product`, and `Sum` now have `Data`,
diff --git a/libraries/base/tests/T10149.hs b/libraries/base/tests/T10149.hs
new file mode 100644
index 0000000..d15b0d7
--- /dev/null
+++ b/libraries/base/tests/T10149.hs
@@ -0,0 +1,19 @@
+import Control.Concurrent
+import Control.Exception
+
+main :: IO ()
+main = do
+    mask $ \unmask -> mask $ \restore ->
+      unmask $ restore $ getMaskingState >>= print
+    uninterruptibleMask $ \unmask -> uninterruptibleMask $ \restore ->
+      unmask $ restore $ getMaskingState >>= print
+
+    mv <- newEmptyMVar
+    mask_ $ -- start with exceptions masked
+      mask $ \restore -> forkIOWithUnmask $ \unmask -> unmask $
+        restore $ getMaskingState >>= print >> putMVar mv ()
+    takeMVar mv
+    uninterruptibleMask_ $ -- start with exceptions uninterruptibly masked
+      uninterruptibleMask $ \restore -> forkIOWithUnmask $ \unmask -> unmask $
+        restore $ getMaskingState >>= print >> putMVar mv ()
+    takeMVar mv
diff --git a/libraries/base/tests/T10149.stdout b/libraries/base/tests/T10149.stdout
new file mode 100644
index 0000000..f78328d
--- /dev/null
+++ b/libraries/base/tests/T10149.stdout
@@ -0,0 +1,4 @@
+MaskedInterruptible
+MaskedUninterruptible
+MaskedInterruptible
+MaskedUninterruptible
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index f53ad0c..00b653b 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -209,3 +209,4 @@ test('T9848',
         , only_ways(['normal'])],
       compile_and_run,
       ['-O'])
+test('T10149',normal, compile_and_run,[''])