From 26021ff9493fb5bceba65415e8689e0d2a170d5e Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 10 Sep 2003 11:46:58 +0000
Subject: [PATCH] [project @ 2003-09-10 11:46:58 by simonmar] The finalizer
 for a ForeignPtr created with mallocForeignPtr better
 "touch#" the MutableByteArray# after running the other
 finalizers, otherwise the memory might be garbage collected
 before we've finished running the finalizers.

This can cause crashes if you add any extra finalizers to a ForeignPtr
created with mallocForeignPtr.

SourceForge bug: #802692
---
 GHC/ForeignPtr.hs |    8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index f67e67f..0069de2 100644
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -159,7 +159,8 @@ addForeignPtrConcFinalizer f@(MallocPtr fo r) finalizer = do
   if (null fs)
      then  IO $ \s -> 
 	       let p = unsafeForeignPtrToPtr f in
-	       case mkWeak# fo () (foreignPtrFinalizer r p) s of 
+	       case mkWeak# fo () (do foreignPtrFinalizer r p
+				      touchPinnedByteArray# fo) s of 
 		  (# s1, w #) -> (# s1, () #)
      else return ()
 
@@ -180,6 +181,9 @@ newForeignPtr_ (Ptr obj) =  do
     case mkForeignObj# obj s# of
       (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# r #)
 
+touchPinnedByteArray# :: MutableByteArray# RealWorld -> IO ()
+touchPinnedByteArray# ba# = IO $ \s -> case touch# ba# s of s -> (# s, () #)
+
 touchForeignPtr :: ForeignPtr a -> IO ()
 -- ^This function ensures that the foreign object in
 -- question is alive at the given place in the sequence of IO
@@ -202,7 +206,7 @@ touchForeignPtr :: ForeignPtr a -> IO ()
 touchForeignPtr (ForeignPtr fo r)
    = IO $ \s -> case touch# fo s of s -> (# s, () #)
 touchForeignPtr (MallocPtr fo r)
-   = IO $ \s -> case touch# fo s of s -> (# s, () #)
+   = touchPinnedByteArray# fo
 
 unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a
 -- ^This function extracts the pointer component of a foreign
-- 
1.7.10.4