ForeignPtr finalizers not searched for reachable objects?

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

Trac metadata

Trac field	Value
Version	8.0.2
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	libraries/base
Test case
Differential revisions
BlockedBy
Related
Blocking
CC	mboes, qnikst
Operating system
Architecture