[commit: ghc] master: Make finalizers more reliable. (01bb17f)

[git at git.haskell.org]

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

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

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

commit 01bb17fd4dc6d92cf08632bbb62656428db6e7fa
Author: Tamar Christina <tamar at zhox.com>
Date:   Tue May 15 21:20:45 2018 -0400

    Make finalizers more reliable.
    
    Ignore any errors thrown by finalizers when running them.
    
    This prevents a faulty finalizer from stopping the rest being called.
    
    Test Plan: ./validate, new test T13167
    
    Reviewers: hvr, bgamari, simonmar
    
    Reviewed By: bgamari, simonmar
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #13167
    
    Differential Revision: https://phabricator.haskell.org/D4693


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

01bb17fd4dc6d92cf08632bbb62656428db6e7fa
 libraries/base/GHC/Weak.hs         |  5 +++--
 libraries/base/tests/T13167.hs     | 29 +++++++++++++++++++++++++++++
 libraries/base/tests/T13167.stdout |  1 +
 libraries/base/tests/all.T         |  1 +
 4 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/libraries/base/GHC/Weak.hs b/libraries/base/GHC/Weak.hs
index 8f886a6..6a53096 100644
--- a/libraries/base/GHC/Weak.hs
+++ b/libraries/base/GHC/Weak.hs
@@ -149,8 +149,9 @@ runFinalizerBatch (I# n) arr =
                   0# -> (# s, () #)
                   _  -> let !m' = m -# 1# in
                         case indexArray# arr m' of { (# io #) ->
-                        case io s of          { s' ->
-                        unIO (go m') s'
+                        case catch# (\p -> (# io p, () #))
+                                    (\_ s'' -> (# s'', () #)) s of          {
+                         (# s', _ #) -> unIO (go m') s'
                         }}
    in
         go n
diff --git a/libraries/base/tests/T13167.hs b/libraries/base/tests/T13167.hs
new file mode 100644
index 0000000..e41104c
--- /dev/null
+++ b/libraries/base/tests/T13167.hs
@@ -0,0 +1,29 @@
+import Data.IORef
+import Control.Monad
+import Control.Exception
+import Control.Concurrent.MVar
+import System.Mem
+
+main :: IO ()
+main = do
+  run
+  run
+  run
+  run
+  m <- newEmptyMVar
+  quit m
+  performMajorGC
+  takeMVar m
+
+run :: IO ()
+run = do
+  ref <- newIORef ()
+  void $ mkWeakIORef ref $ do
+    putStr "."
+    throwIO $ ErrorCall "failed"
+
+quit :: MVar () -> IO ()
+quit m = do
+  ref <- newIORef ()
+  void $ mkWeakIORef ref $ do
+    putMVar m ()
diff --git a/libraries/base/tests/T13167.stdout b/libraries/base/tests/T13167.stdout
new file mode 100644
index 0000000..4918d25
--- /dev/null
+++ b/libraries/base/tests/T13167.stdout
@@ -0,0 +1 @@
+....
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 491df2f..d530e10 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -224,3 +224,4 @@ test('T3474',
 test('T14425', normal, compile_and_run, [''])
 test('T10412', normal, compile_and_run, [''])
 test('T13896', normal, compile_and_run, [''])
+test('T13167', normal, compile_and_run, [''])