Ticket #2554: Test.hs

File Test.hs, 652 bytes (added by judah, 6 years ago)

Test code to reproduce the error.

Line 
1{-# LANGUAGE ForeignFunctionInterface #-}
2module Main where
3
4import Control.Concurrent
5
6import Foreign.C
7import Foreign.Ptr
8
9main = do
10    put <- mkCallback testFunc
11    callFunc put
12    forkAndKill
13    callFunc put
14    freeHaskellFunPtr put
15
16-- fork a thread, and kill it before it's finished
17forkAndKill :: IO ()
18forkAndKill = do
19            tid <- forkIO $ threadDelay 3000000
20            threadDelay 1000000
21            killThread tid
22
23testFunc :: FuncCall
24testFunc = return ()
25       
26type FuncCall = IO ()
27
28foreign import ccall "wrapper" mkCallback :: FuncCall -> IO (FunPtr FuncCall)
29
30foreign import ccall callFunc :: FunPtr FuncCall -> IO ()
31