Ticket #7539: TestGhc.hs

File TestGhc.hs, 1.3 KB (added by edsko, 16 months ago)

Demonstrates the crash

Line 
1module Main where
2
3import System.Process (readProcess)
4import GHC
5import Config
6
7getGhcLibdir :: IO FilePath
8getGhcLibdir = do
9  let ghcbinary = "ghc-" ++ cProjectVersion
10  out <- readProcess ghcbinary ["--print-libdir"] ""
11  case lines out of
12    [libdir] -> return libdir
13    _        -> fail "cannot parse output of ghc --print-libdir"
14
15runFromGhc :: Ghc a -> IO a
16runFromGhc a = do
17  libdir <- getGhcLibdir
18  runGhc (Just libdir) a
19
20compileInGhc :: FilePath -> Ghc SuccessFlag
21compileInGhc target = do
22  flags0 <- getSessionDynFlags
23  -- let flags = flags0 { hscTarget = HscNothing, ghcLink = LinkBinary } -- Okay
24  -- let flags = flags0 { hscTarget = HscNothing, ghcLink = LinkInMemory } -- Crashes
25  let flags = flags0 { hscTarget = HscNothing, ghcLink = NoLink } -- Crashes
26  setSessionDynFlags flags
27  addTarget Target { targetId           = TargetFile target Nothing
28                   , targetAllowObjCode = True
29                   , targetContents     = Nothing
30                   }
31  load LoadAllTargets
32
33runInGhc :: (String, String) -> Ghc GHC.RunResult
34runInGhc (m, fun) = do
35  setContext $ [ IIDecl $ simpleImportDecl $ mkModuleName m ]
36  runStmt (m ++ "." ++ fun) RunToCompletion
37
38main :: IO RunResult
39main = runFromGhc $ do compileInGhc "A.hs" ; runInGhc ("Main", "main")