summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/ffi/should_run/ffi020.hs
blob: d2236f5791abcf99b6ee62dc1d742f41f43f6dc2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
import Foreign
import Data.Word
import Control.Monad
import System.Mem

main = do
  let finalize p = do
        putStrLn ("finalize: " ++ show p)
        free p
  allocToForeignPtr finalize (mallocBytes 4096)
  forever performGC

allocToForeignPtr :: (Ptr a -> IO ())    -- finalizer
                  -> IO (Ptr a)          -- allocate
                  -> IO (ForeignPtr a)
allocToForeignPtr fin alloc = do
  done <- asFinalizer fin
  newForeignPtr done =<< alloc

asFinalizer :: (Ptr a -> IO ()) -> IO (FinalizerPtr a)
asFinalizer = mkFinalizer
foreign import ccall "wrapper"
  mkFinalizer :: (Ptr a -> IO ())
              -> IO (FinalizerPtr a)