Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/fd681c4ff2f82c7d40ed09ec6dd8d39577ab9f24 >--------------------------------------------------------------- commit fd681c4ff2f82c7d40ed09ec6dd8d39577ab9f24 Author: Simon Marlow <marlo...@gmail.com> Date: Fri Dec 7 12:08:28 2012 +0000 add test for #7478 >--------------------------------------------------------------- tests/ghc-api/T7478/A.hs | 6 ++++ tests/ghc-api/T7478/B.hs | 4 ++ tests/ghc-api/T7478/C.hs | 4 ++ tests/ghc-api/T7478/Makefile | 11 +++++++ tests/ghc-api/T7478/T7478.hs | 61 ++++++++++++++++++++++++++++++++++++++ tests/ghc-api/T7478/T7478.stdout | 8 +++++ tests/ghc-api/T7478/all.T | 2 + 7 files changed, 96 insertions(+), 0 deletions(-) diff --git a/tests/ghc-api/T7478/A.hs b/tests/ghc-api/T7478/A.hs new file mode 100644 index 0000000..bea1b1a --- /dev/null +++ b/tests/ghc-api/T7478/A.hs @@ -0,0 +1,6 @@ +module Main where + +import B + +main :: IO () +main = B.b >> 42 diff --git a/tests/ghc-api/T7478/B.hs b/tests/ghc-api/T7478/B.hs new file mode 100644 index 0000000..2c71d18 --- /dev/null +++ b/tests/ghc-api/T7478/B.hs @@ -0,0 +1,4 @@ +module B where + +b :: IO () +b = return () diff --git a/tests/ghc-api/T7478/C.hs b/tests/ghc-api/T7478/C.hs new file mode 100644 index 0000000..d82a4bd --- /dev/null +++ b/tests/ghc-api/T7478/C.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () diff --git a/tests/ghc-api/T7478/Makefile b/tests/ghc-api/T7478/Makefile new file mode 100644 index 0000000..1afb16d --- /dev/null +++ b/tests/ghc-api/T7478/Makefile @@ -0,0 +1,11 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean: + rm -f *.o *.hi + +T7478: clean + '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T7478.hs + ./T7478 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + diff --git a/tests/ghc-api/T7478/T7478.hs b/tests/ghc-api/T7478/T7478.hs new file mode 100644 index 0000000..15c3559 --- /dev/null +++ b/tests/ghc-api/T7478/T7478.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE NamedFieldPuns #-} +module Main (main) where + +import Data.List ((\\)) +import Control.Monad (void) +import System.Environment + +import GHC +import qualified Config as GHC +import qualified Outputable as GHC +import GhcMonad (liftIO) +import Outputable (PprStyle, qualName, qualModule) + +compileInGhc :: [FilePath] -- ^ Targets + -> (String -> IO ()) -- ^ handler for each SevOutput message + -> Ghc () +compileInGhc targets handlerOutput = do + -- Set flags + flags0 <- getSessionDynFlags + let flags = flags0 {verbosity = 1, log_action = collectSrcError handlerOutput} + setSessionDynFlags flags + -- Set up targets. + oldTargets <- getTargets + let oldFiles = map fileFromTarget oldTargets + mapM_ addSingle (targets \\ oldFiles) + mapM_ (removeTarget . targetIdFromFile) $ oldFiles \\ targets + -- Load modules to typecheck + void $ load LoadAllTargets + where + targetIdFromFile file = TargetFile file Nothing + + addSingle filename = + addTarget Target + { targetId = targetIdFromFile filename + , targetAllowObjCode = True + , targetContents = Nothing + } + + fileFromTarget Target{targetId} = + case targetId of + TargetFile file Nothing -> file + _ -> error "fileFromTarget: not a known target" + + collectSrcError handlerOutput flags SevOutput _srcspan style msg + = handlerOutput $ GHC.showSDocForUser flags (qualName style,qualModule style) msg + collectSrcError _ _ _ _ _ _ + = return () + +main :: IO () +main = do + [libdir] <- getArgs + runGhc (Just libdir) $ do + + liftIO $ putStrLn "----- 0 ------" + compileInGhc ["A.hs", "B.hs"] $ \msg -> print (0 :: Int, msg) + + liftIO $ putStrLn "----- 1 ------" + compileInGhc ["A.hs", "B.hs"] $ \msg -> print (1 :: Int, msg) + + liftIO $ putStrLn "----- 2 ------" + compileInGhc ["C.hs"] $ \msg -> print (2 :: Int, msg) diff --git a/tests/ghc-api/T7478/T7478.stdout b/tests/ghc-api/T7478/T7478.stdout new file mode 100644 index 0000000..372cf9b --- /dev/null +++ b/tests/ghc-api/T7478/T7478.stdout @@ -0,0 +1,8 @@ +----- 0 ------ +(0,"[1 of 2] Compiling B ( B.hs, B.o )") +(0,"[2 of 2] Compiling Main ( A.hs, A.o )") +----- 1 ------ +(1,"[2 of 2] Compiling Main ( A.hs, A.o )") +----- 2 ------ +(2,"[1 of 1] Compiling Main ( C.hs, C.o )") +(2,"Linking A ...") diff --git a/tests/ghc-api/T7478/all.T b/tests/ghc-api/T7478/all.T new file mode 100644 index 0000000..5ba40f0 --- /dev/null +++ b/tests/ghc-api/T7478/all.T @@ -0,0 +1,2 @@ +test('T7478', extra_clean(['A','A.exe','B.o','B.hi','C.o','C.hi']), run_command, ['$MAKE -s --no-print-directory T7478']) + _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
