Permalink
Browse files

Merge branch 'master' of github.com:haskell/cabal

  • Loading branch information...
2 parents 09f9c47 + d81b805 commit 31c3f404dceb221d7281467a66bf68cc166fc2d9 @igfoo igfoo committed Oct 5, 2012
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
module PackageTests.PackageTester (
PackageSpec(..),
Success(..),
@@ -17,9 +18,11 @@ module PackageTests.PackageTester (
) where
import qualified Control.Exception.Extensible as E
+import System.Environment (getEnv)
import System.Directory
import System.FilePath
import System.IO
+import System.IO.Error (isDoesNotExistError)
import System.Posix.IO
import System.Process
import System.Exit
@@ -78,7 +81,8 @@ doCabalConfigure :: PackageSpec -> IO Result
doCabalConfigure spec = do
cleanResult@(_, _, cleanOutput) <- cabal spec ["clean"]
requireSuccess cleanResult
- res <- cabal spec $ ["configure", "--user"] ++ configOpts spec
+ ghc <- getGHC
+ res <- cabal spec $ ["configure", "--user", "-w", ghc] ++ configOpts spec
return $ recordRun res ConfigureSuccess nullResult
doCabalBuild :: PackageSpec -> IO Result
@@ -99,7 +103,8 @@ cabal_build spec = do
unregister :: String -> IO ()
unregister libraryName = do
- res@(_, _, output) <- run Nothing "ghc-pkg" ["unregister", "--user", libraryName]
+ ghcPkg <- getGHCPkg
+ res@(_, _, output) <- run Nothing ghcPkg ["unregister", "--user", libraryName]
if "cannot find package" `isInfixOf` output
then return ()
else requireSuccess res
@@ -135,7 +140,8 @@ cabal_bench spec extraArgs = do
cabal :: PackageSpec -> [String] -> IO (String, ExitCode, String)
cabal spec cabalArgs = do
wd <- getCurrentDirectory
- r <- run (Just $ directory spec) "ghc"
+ ghc <- getGHC
+ r <- run (Just $ directory spec) ghc
[ "--make"
-- HPC causes trouble -- see #1012
-- , "-fhpc"
@@ -182,7 +188,8 @@ record :: PackageSpec -> Result -> IO ()
record spec res = do
C.writeFile (directory spec </> "test-log.txt") (C.pack $ outputText res)
--- Test helpers:
+------------------------------------------------------------------------
+-- Test helpers
assertBuildSucceeded :: Result -> Assertion
assertBuildSucceeded result = unless (successful result) $
@@ -215,3 +222,27 @@ assertOutputContains needle result =
" expected: " ++ needle ++
"in output: " ++ output
where output = outputText result
+
+------------------------------------------------------------------------
+-- Finding ghc and related tools
+--
+-- To allow the test suite to be run using other GHC versions than the
+-- one symlinked as ghc, we look in the environment for GHC and
+-- GHC_PKG.
+
+lookupEnv :: String -> IO (Maybe String)
+lookupEnv name =
+ (fmap Just $ getEnv name)
+ `E.catch` \ (e :: IOError) ->
+ if isDoesNotExistError e
+ then return Nothing
+ else E.throw e
+
+getGHC :: IO String
+getGHC = fromMaybe "ghc" `fmap` lookupEnv "GHC"
+
+getGHCPkg :: IO String
+getGHCPkg = do
+ ghc <- getGHC
+ -- Somewhat brittle, but better than nothing.
+ return $ "ghc-pkg" ++ drop 3 ghc
@@ -31,7 +31,7 @@ profiling = TestCase $ do
,"--enable-executable-profiling"]
spec = PackageSpec ("PackageTests" </> "TemplateHaskell" </> "profiling") flags
result <- cabal_build spec
- assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
+ assertBuildSucceeded result
dynamic :: Test
dynamic = TestCase $ do
@@ -40,5 +40,4 @@ dynamic = TestCase $ do
,"--enable-executable-dynamic"]
spec = PackageSpec ("PackageTests" </> "TemplateHaskell" </> "dynamic") flags
result <- cabal_build spec
- assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
-
+ assertBuildSucceeded result
@@ -36,7 +36,7 @@ import Distribution.Text
import Distribution.Version
( Version )
-import System.Time (getClockTime, toCalendarTime)
+import Data.Time (getCurrentTime)
import System.FilePath ((</>), (<.>))
import Control.Monad (when, unless)
import Data.Maybe (isNothing)
@@ -60,7 +60,7 @@ sdist flags exflags = do
when (isNothing mb_lbi) $
warn verbosity "Cannot run preprocessors. Run 'configure' command first."
- date <- toCalendarTime =<< getClockTime
+ date <- getCurrentTime
let pkg' | snapshot = snapshotPackage date pkg
| otherwise = pkg

0 comments on commit 31c3f40

Please sign in to comment.