[GHC] #13439: ForeignPtr finalizers not searched for reachable objects?

[GHC]

#13439: ForeignPtr finalizers not searched for reachable objects?
-------------------------------------+-------------------------------------
           Reporter:                 |             Owner:  (none)
  facundo.dominguez                  |
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:                 |           Version:  8.0.2
  libraries/base                     |
           Keywords:  ForeignPtr     |  Operating System:  Unknown/Multiple
  finalizers                         |
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 The following program produces pairs of ForeignPtr's. The finalizer of the
 second ForeignPtr, uses the first ForeignPtr.

 When running this program it looks like the first ForeignPtr is finalized
 before the second one.

 {{{
 import Control.Concurrent
 import Foreign.Concurrent (newForeignPtr)
 import Control.Monad
 import Foreign.ForeignPtr hiding (newForeignPtr)
 import Foreign.Ptr
 import System.Mem (performMajorGC)
 import Data.IORef
 import Data.Set as Set

 main = do
     rFinalized <- newIORef Set.empty
     forM_ [0..50000] $ \i -> do
       fp0 <- newForeignPtr nullPtr $
                atomicModifyIORef' rFinalized (\s -> (Set.insert i s, ()))
       newForeignPtr nullPtr $ do
         finalized <- atomicModifyIORef' rFinalized
                        (\s -> (Set.delete i s, Set.member i s))
         when finalized $
           putStrLn "fp0 was prematurely finalized"
         touchForeignPtr fp0
     performMajorGC
     threadDelay 1000000
 }}}

 {{{
 $ ghc t.hs
 [1 of 1] Compiling Main             ( t.hs, t.o )
 Linking t ...
 $ ./t
 fp0 was prematurely finalized
 fp0 was prematurely finalized
 fp0 was prematurely finalized
 fp0 was prematurely finalized
 fp0 was prematurely finalized
 }}}

 Is this a bug in the implementation or an omission in the documentation of
 `Foreign.Concurrent.newForeignPtr`?

 Note that a more obvious program behaves correctly.
 {{{
 main = do
     rFinalized <- newIORef False
     fp0 <- newForeignPtr nullPtr $
              writeIORef rFinalized True
     newForeignPtr nullPtr $ do
       finalized <- readIORef rFinalized
       when finalized $
         putStrLn "fp0 was prematurely finalized"
       touchForeignPtr fp0
     performMajorGC
     threadDelay 1000000
 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13439>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler