Commit 41b75520 authored by Edward Z. Yang's avatar Edward Z. Yang

Add tests for interruptible FFI annotation

parent 93c94f60
......@@ -133,6 +133,10 @@ test('conc035', only_compiler_types(['ghc']), compile_and_run, [''])
test('conc036', compose(skip_if_fast,
compose(omit_ways(['ghci','threaded2']),
only_compiler_types(['ghc']))), compile_and_run, [''])
# Interrupting foreign calls only makes sense if we are threaded
test('foreignInterruptible', composes([skip_if_fast,
only_threaded_ways,
only_compiler_types(['ghc'])]), compile_and_run, [''])
test('conc037', only_ways(['threaded1','threaded2']), compile_and_run, [''])
test('conc038', only_ways(['threaded1','threaded2']), compile_and_run, [''])
......
{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS -cpp #-}
module Main where
import Control.Concurrent
import Control.Exception
import Prelude hiding (catch)
import Foreign
import System.IO
#ifdef mingw32_HOST_OS
sleep n = sleepBlock (n*1000)
foreign import stdcall interruptible "Sleep" sleepBlock :: Int -> IO ()
#else
sleep n = sleepBlock n
foreign import ccall interruptible "sleep" sleepBlock :: Int -> IO ()
#endif
main :: IO ()
main = do
newStablePtr stdout -- prevent stdout being finalized
th <- newEmptyMVar
tid <- forkIO $ do
putStrLn "newThread started"
(sleep 2 >> putStrLn "fail") `catch` (\ThreadKilled -> putStrLn "pass")
putMVar th "child"
yield
threadDelay 500000
killThread tid
x <- takeMVar th
putStrLn x
putStrLn "\nshutting down"
......@@ -22,6 +22,9 @@ dynamic = [head dynamic]
unsafe :: [unsafe]
unsafe = [head unsafe]
interruptible :: [interruptible]
interruptible = [head interruptible]
stdcall :: [stdcall]
stdcall = [head stdcall]
......
{-# LANGUAGE TemplateHaskell,ForeignFunctionInterface #-}
module TH_foreign where
import Foreign.Ptr
import Language.Haskell.TH
$(return [ForeignD (ImportF CCall Interruptible "&" (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))])
-- Should generate the same as this:
foreign import ccall interruptible "&" foo1 :: Ptr ()
TH_foreignInterruptible.hs:1:1:
TH_foreignInterruptible.hs:1:1: Splicing declarations
return
[ForeignD
(ImportF
CCall
Interruptible
"&"
(mkName "foo")
(AppT (ConT 'Ptr) (ConT '())))]
======>
TH_foreignInterruptible.hs:8:3-100
foreign import ccall interruptible "static &foo" foo
:: Ptr GHC.Unit.()
......@@ -157,6 +157,8 @@ test('T3177', normal, compile, ['-v0'])
test('T3177a', normal, compile_fail, ['-v0'])
test('T3319', normal, compile, ['-ddump-splices -v0'])
test('TH_foreignInterruptible', normal, compile, ['-ddump-splices -v0'])
test('T3395', normal, compile_fail, ['-v0'])
test('T3467', normal, compile, [''])
test('T3572', normal, compile_and_run, [''])
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment