Commit 8647288e authored by Thomas Schilling's avatar Thomas Schilling
Browse files

Add first test for GHC API features.

parent 29a86320
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
{-# OPTIONS_GHC -Wall #-}
module A where
import B
import System.IO
main = do
print answer_to_live_the_universe_and_everything
hFlush stdout
{-# OPTIONS_GHC -Wall #-}
module B where
answer_to_live_the_universe_and_everything =
length [1..23*2] - 4
\ No newline at end of file
TOP=../../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
clean:
@rm -f *.o *.hi
apirecomp001: clean
@$(TEST_HC) --make -v0 -package ghc myghc.hs
@myghc $(TOP)/..
test('apirecomp001', skip_if_fast, run_command, ['$MAKE -s --no-print-directory apirecomp001'])
True
True
target nothing: ok
True
True
target interpreted: ok
42
ok
-- 1. Load a set of modules with "nothing" target
-- 2. Load it again with "interpreted" target
-- 3. Execute some code
-- a. If the recompilation checker is buggy this will die due to missing
-- code
-- b. If it's correct, it will recompile because the target has changed.
--
-- This program must be called with GHC's libdir as the single command line
-- argument.
module Main where
import GHC
import MonadUtils ( MonadIO(..) )
import BasicTypes ( failed )
import Bag ( bagToList )
import System.Environment
import Control.Monad
import System.IO
main = do
[libdir] <- getArgs
runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
setSessionDynFlags $ dflags { hscTarget = HscNothing
, ghcLink = LinkInMemory
, verbosity = 0 -- silence please
}
root_mod <- guessTarget "A.hs" Nothing
setTargets [root_mod]
ok <- loadWithLogger myLogger LoadAllTargets
when (failed ok) $ error "Couldn't load A.hs in nothing mode"
prn "target nothing: ok"
dflags <- getSessionDynFlags
setSessionDynFlags $ dflags { hscTarget = HscInterpreted }
ok <- loadWithLogger myLogger LoadAllTargets
when (failed ok) $ error "Couldn't load A.hs in interpreted mode"
prn "target interpreted: ok"
-- set context to module "A"
mg <- getModuleGraph
let [mod] = [ ms_mod m | m <- mg, moduleNameString (ms_mod_name m) == "A" ]
setContext [mod] []
liftIO $ hFlush stdout -- make sure things above are printed before
-- interactive output
r <- runStmt "main" RunToCompletion
case r of
RunOk _ -> prn "ok"
RunFailed -> prn "compilation failed"
RunException _ -> prn "exception"
RunBreak _ _ _ -> prn "breakpoint"
liftIO $ hFlush stdout
return ()
-- prints number of warnings; this is our indicator for recompilation. We ignore
-- the number of warnings since this might change, however, there should always
-- be at least one.
myLogger _ = do
ws <- getWarnings
clearWarnings
liftIO $ print (length (bagToList ws) > 0)
prn :: MonadIO m => String -> m ()
prn = liftIO . putStrLn
\ No newline at end of file
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