Created
November 16, 2017 21:41
-
-
Save ndmitchell/c13cd8b9b5dafbfdcfe9b1af4e23af6b to your computer and use it in GitHub Desktop.
Exceptions from "wrapper" functions
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- ghc bug.hs c.c && bug | |
module Main(main) where | |
import Control.Concurrent | |
import Control.Monad | |
import Foreign.C | |
import Foreign.Ptr | |
foreign import ccall apply :: FunPtr (CString -> IO CString) -> CString -> IO CString | |
foreign import ccall "wrapper" wrapper :: (CString -> IO CString) -> IO (FunPtr (CString -> IO CString)) | |
main :: IO () | |
main = do | |
putStrLn "starting" | |
main <- myThreadId | |
threads <- replicateM 100 $ forkIO $ | |
withCString "hello" $ \ptr -> do | |
let f x = do | |
error "die" | |
return x | |
ff <- wrapper f | |
res <- apply ff ptr | |
print =<< peekCString res | |
threadDelay 10000000 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
char* apply(char*(*f)(char*), char* x) | |
{ | |
return f(x); | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment