Revert "Make the linker API thread-safe"
[ghc.git] / testsuite / tests / rts / rdynamic.hs
1 -- | A test to load symbols exposed with @-rdynamic@.
2 --
3 -- Exporting 'f' from Main is important, otherwise, the corresponding symbol
4 -- wouldn't appear in symbol tables.
5 --
6 {-# LANGUAGE ForeignFunctionInterface #-}
7 {-# LANGUAGE MagicHash #-}
8 {-# LANGUAGE UnboxedTuples #-}
9 module Main(main, f) where
10
11 import Foreign.C.String ( withCString, CString )
12 import GHC.Exts ( addrToAny# )
13 import GHC.Ptr ( Ptr(..), nullPtr )
14 import System.Info ( os )
15 import Encoding
16
17 main = (loadFunction Nothing "Main" "f" :: IO (Maybe String)) >>= print
18
19 f :: String
20 f = "works"
21
22 -- loadFunction__ taken from
23 -- @plugins-1.5.4.0:System.Plugins.Load.loadFunction__@
24 loadFunction :: Maybe String
25 -> String
26 -> String
27 -> IO (Maybe a)
28 loadFunction mpkg m valsym = do
29 let symbol = prefixUnderscore
30 ++ maybe "" (\p -> zEncodeString p ++ "_") mpkg
31 ++ zEncodeString m ++ "_" ++ zEncodeString valsym
32 ++ "_closure"
33 ptr@(Ptr addr) <- withCString symbol c_lookupSymbol
34 if (ptr == nullPtr)
35 then return Nothing
36 else case addrToAny# addr of
37 (# hval #) -> return ( Just hval )
38 where
39 prefixUnderscore = if elem os ["darwin","mingw32","cygwin"] then "_" else ""
40
41 foreign import ccall safe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)