[commit: testsuite] master: add test for #7478 (fd681c4)

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/fd681c4ff2f82c7d40ed09ec6dd8d39577ab9f24

>---------------------------------------------------------------

commit fd681c4ff2f82c7d40ed09ec6dd8d39577ab9f24
Author: Simon Marlow <[email protected]>
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'])
+