Skip to content
Browse files

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

  • Loading branch information...
2 parents 15fd935 + 363165b commit 1d8ca4552f259ee596edca7212a22ebee88b87e1 @igfoo igfoo committed Sep 26, 2012
View
3 Cabal/Distribution/Simple/GHC.hs
@@ -214,7 +214,8 @@ guessToolFromGhcPath tool ghcProg verbosity
info verbosity $ "looking for tool " ++ show tool ++ " near compiler in " ++ dir
exists <- mapM doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
- [] -> return Nothing
+ -- If we can't find it near ghc, fall back to the usual method.
+ [] -> findProgramLocation verbosity tool
(fp:_) -> do info verbosity $ "found " ++ tool ++ " in " ++ fp
return (Just fp)
View
18 Cabal/Distribution/Simple/Test.hs
@@ -71,7 +71,7 @@ import Distribution.Simple.InstallDirs
import qualified Distribution.Simple.LocalBuildInfo as LBI
( LocalBuildInfo(..) )
import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag )
-import Distribution.Simple.Utils ( die, notice )
+import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
import Distribution.TestSuite
( OptionDescr(..), Options, Progress(..), Result(..), TestInstance(..)
, Test(..) )
@@ -91,7 +91,6 @@ import System.Environment ( getEnvironment )
import System.Exit ( ExitCode(..), exitFailure, exitWith )
import System.FilePath ( (</>), (<.>) )
import System.IO ( hClose, IOMode(..), openFile )
-import System.Process ( runProcess, waitForProcess )
-- | Logs all test results for a package, broken down first by test suite and
-- then by test case.
@@ -191,10 +190,10 @@ testController flags pkg_descr lbi suite preTest cmd postTest logNamer = do
pwd <- getCurrentDirectory
existingEnv <- getEnvironment
let dataDirPath = pwd </> PD.dataDir pkg_descr
- shellEnv = Just $ (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
- : ("HPCTIXFILE", (</>) pwd
- $ tixFilePath distPref $ PD.testName suite)
- : existingEnv
+ shellEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
+ : ("HPCTIXFILE", (</>) pwd
+ $ tixFilePath distPref $ PD.testName suite)
+ : existingEnv
bracket (openCabalTemp testLogDir) deleteIfExists $ \tempLog ->
bracket (openCabalTemp testLogDir) deleteIfExists $ \tempInput -> do
@@ -223,10 +222,9 @@ testController flags pkg_descr lbi suite preTest cmd postTest logNamer = do
exit <- do
hLog <- openFile tempLog AppendMode
hIn <- openFile tempInput ReadMode
- -- these handles get closed by runProcess
- proc <- runProcess cmd opts Nothing shellEnv
- (Just hIn) (Just hLog) (Just hLog)
- waitForProcess proc
+ -- these handles get closed by rawSystemIOWithEnv
+ rawSystemIOWithEnv verbosity cmd opts shellEnv (Just hIn)
+ (Just hLog) (Just hLog)
-- Generate TestSuiteLog from executable exit code and a machine-
-- readable test log
View
19 Cabal/Distribution/Simple/Utils.hs
@@ -62,6 +62,7 @@ module Distribution.Simple.Utils (
rawSystemExitWithEnv,
rawSystemStdout,
rawSystemStdInOut,
+ rawSystemIOWithEnv,
maybeExit,
xargs,
findProgramLocation,
@@ -401,6 +402,24 @@ rawSystemExitWithEnv verbosity path args env = do
debug verbosity $ path ++ " returned " ++ show exitcode
exitWith exitcode
+-- Closes the passed in handles before returning.
+rawSystemIOWithEnv :: Verbosity
+ -> FilePath
+ -> [String]
+ -> [(String, String)]
+ -> Maybe Handle -- ^ stdin
+ -> Maybe Handle -- ^ stdout
+ -> Maybe Handle -- ^ stderr
+ -> IO ExitCode
+rawSystemIOWithEnv verbosity path args env inp out err = do
+ printRawCommandAndArgsAndEnv verbosity path args env
+ hFlush stdout
+ ph <- runProcess path args Nothing (Just env) inp out err
+ exitcode <- waitForProcess ph
+ unless (exitcode == ExitSuccess) $ do
+ debug verbosity $ path ++ " returned " ++ show exitcode
+ return exitcode
+
-- | Run a command and return its output.
--
-- The output is assumed to be text in the locale encoding.
View
3 Cabal/tests/PackageTests/BenchmarkExeV10/Check.hs
@@ -17,5 +17,4 @@ checkBenchmark :: Version -> Test
checkBenchmark cabalVersion = TestCase $ do
let spec = PackageSpec dir ["--enable-benchmarks"]
buildResult <- cabal_build spec
- let buildMessage = "\'setup build\' should succeed"
- assertEqual buildMessage True $ successful buildResult
+ assertBuildSucceeded buildResult
View
15 Cabal/tests/PackageTests/BuildDeps/InternalLibrary0/Check.hs
@@ -14,13 +14,8 @@ suite :: Version -> Test
suite cabalVersion = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary0") []
result <- cabal_build spec
- do
- assertEqual "cabal build should fail" False (successful result)
- when (cabalVersion >= Version [1, 7] []) $ do
- let sb = "library which is defined within the same package."
- -- In 1.7 it should tell you how to enable the desired behaviour.
- assertEqual ("cabal output should say "++show sb) True $
- sb `isInfixOf` (intercalate " " $ lines $ outputText result)
- `catch` \exc -> do
- putStrLn $ "Cabal result was "++show result
- throwIO (exc :: SomeException)
+ assertBuildFailed result
+ when (cabalVersion >= Version [1, 7] []) $ do
+ let sb = "library which is defined within the same package."
+ -- In 1.7 it should tell you how to enable the desired behaviour.
+ assertOutputContains sb result
View
6 Cabal/tests/PackageTests/BuildDeps/InternalLibrary1/Check.hs
@@ -11,8 +11,4 @@ suite :: Test
suite = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary1") []
result <- cabal_build spec
- do
- assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
- `catch` \exc -> do
- putStrLn $ "Cabal result was "++show result
- throwIO (exc :: SomeException)
+ assertBuildSucceeded result
View
12 Cabal/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs
@@ -15,17 +15,9 @@ suite = TestCase $ do
unregister "InternalLibrary2"
iResult <- cabal_install specTI
- do
- assertEqual "cabal install should succeed" True (successful iResult)
- `catch` \exc -> do
- putStrLn $ "Cabal result was "++show iResult
- throwIO (exc :: SomeException)
+ assertInstallSucceeded iResult
bResult <- cabal_build spec
- do
- assertEqual "cabal build should succeed" True (successful bResult)
- `catch` \exc -> do
- putStrLn $ "Cabal result was "++show bResult
- throwIO (exc :: SomeException)
+ assertBuildSucceeded bResult
unregister "InternalLibrary2"
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
View
12 Cabal/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs
@@ -15,17 +15,9 @@ suite = TestCase $ do
unregister "InternalLibrary3"
iResult <- cabal_install specTI
- do
- assertEqual "cabal install should succeed - see to-install/test-log.txt" True (successful iResult)
- `catch` \exc -> do
- putStrLn $ "Cabal result was "++show iResult
- throwIO (exc :: SomeException)
+ assertInstallSucceeded iResult
bResult <- cabal_build spec
- do
- assertEqual "cabal build should succeed - see test-log.txt" True (successful bResult)
- `catch` \exc -> do
- putStrLn $ "Cabal result was "++show bResult
- throwIO (exc :: SomeException)
+ assertBuildSucceeded bResult
unregister "InternalLibrary3"
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
View
12 Cabal/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs
@@ -15,17 +15,9 @@ suite = TestCase $ do
unregister "InternalLibrary4"
iResult <- cabal_install specTI
- do
- assertEqual "cabal install should succeed - see to-install/test-log.txt" True (successful iResult)
- `catch` \exc -> do
- putStrLn $ "Cabal result was "++show iResult
- throwIO (exc :: SomeException)
+ assertInstallSucceeded iResult
bResult <- cabal_build spec
- do
- assertEqual "cabal build should succeed - see test-log.txt" True (successful bResult)
- `catch` \exc -> do
- putStrLn $ "Cabal result was "++show bResult
- throwIO (exc :: SomeException)
+ assertBuildSucceeded bResult
unregister "InternalLibrary4"
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
View
50 Cabal/tests/PackageTests/PackageTester.hs
@@ -8,7 +8,12 @@ module PackageTests.PackageTester (
cabal_bench,
cabal_install,
unregister,
- run
+ run,
+ assertBuildSucceeded,
+ assertBuildFailed,
+ assertTestSucceeded,
+ assertInstallSucceeded,
+ assertOutputContains
) where
import qualified Control.Exception.Extensible as E
@@ -25,6 +30,7 @@ import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
+import Test.HUnit
data PackageSpec =
@@ -167,13 +173,45 @@ run cwd cmd args = do
suckH (c:output) h
requireSuccess :: (String, ExitCode, String) -> IO ()
-requireSuccess (cmd, exitCode, output) = do
- case exitCode of
- ExitSuccess -> return ()
- ExitFailure r -> do
- ioError $ userError $ "Command " ++ cmd ++ " failed."
+requireSuccess (cmd, exitCode, output) =
+ unless (exitCode == ExitSuccess) $
+ assertFailure $ "Command " ++ cmd ++ " failed.\n" ++
+ "output: " ++ output
record :: PackageSpec -> Result -> IO ()
record spec res = do
C.writeFile (directory spec </> "test-log.txt") (C.pack $ outputText res)
+-- Test helpers:
+
+assertBuildSucceeded :: Result -> Assertion
+assertBuildSucceeded result = unless (successful result) $
+ assertFailure $
+ "expected: \'setup build\' should succeed\n" ++
+ " output: " ++ outputText result
+
+assertBuildFailed :: Result -> Assertion
+assertBuildFailed result = when (successful result) $
+ assertFailure $
+ "expected: \'setup build\' should fail\n" ++
+ " output: " ++ outputText result
+
+assertTestSucceeded :: Result -> Assertion
+assertTestSucceeded result = unless (successful result) $
+ assertFailure $
+ "expected: \'setup test\' should succeed\n" ++
+ " output: " ++ outputText result
+
+assertInstallSucceeded :: Result -> Assertion
+assertInstallSucceeded result = unless (successful result) $
+ assertFailure $
+ "expected: \'setup install\' should succeed\n" ++
+ " output: " ++ outputText result
+
+assertOutputContains :: String -> Result -> Assertion
+assertOutputContains needle result =
+ unless (needle `isInfixOf` (intercalate " " $ lines output)) $
+ assertFailure $
+ " expected: " ++ needle ++
+ "in output: " ++ output
+ where output = outputText result
View
12 Cabal/tests/PackageTests/TestSuiteExeV10/Check.hs
@@ -18,23 +18,19 @@ checkTest :: Version -> Test
checkTest cabalVersion = TestCase $ do
let spec = PackageSpec dir ["--enable-tests"]
buildResult <- cabal_build spec
- let buildMessage = "\'setup build\' should succeed"
- assertEqual buildMessage True $ successful buildResult
+ assertBuildSucceeded buildResult
testResult <- cabal_test spec []
- let testMessage = "\'setup test\' should succeed"
- assertEqual testMessage True $ successful testResult
+ assertTestSucceeded testResult
checkTestWithHpc :: Version -> Test
checkTestWithHpc cabalVersion = TestCase $ do
let spec = PackageSpec dir [ "--enable-tests"
, "--enable-library-coverage"
]
buildResult <- cabal_build spec
- let buildMessage = "\'setup build\' should succeed"
- assertEqual buildMessage True $ successful buildResult
+ assertBuildSucceeded buildResult
testResult <- cabal_test spec []
- let testMessage = "\'setup test\' should succeed"
- assertEqual testMessage True $ successful testResult
+ assertTestSucceeded testResult
let dummy = emptyTestSuite { testName = "test-Foo" }
tixFile = tixFilePath (dir </> "dist") $ testName dummy
tixFileMessage = ".tix file should exist"
View
6 cabal-install/Distribution/Client/BuildReports/Upload.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP, PatternGuards #-}
-- This is a quick hack for uploading build reports to Hackage.
module Distribution.Client.BuildReports.Upload
@@ -51,7 +51,11 @@ postBuildReport uri buildReport = do
}
case rspCode response of
(3,0,3) | [Just buildId] <- [ do rel <- parseRelativeReference location
+#if MIN_VERSION_network(2,4,0)
+ return $ relativeTo rel uri
+#else
relativeTo rel uri
+#endif
| Header HdrLocation location <- rspHeaders response ]
-> return $ buildId
_ -> error "Unrecognised response from server."
View
2 cabal-install/bootstrap.sh
@@ -55,7 +55,7 @@ CABAL_VER="1.16.0"; CABAL_VER_REGEXP="1\.(13\.3|1[4-7]\.)" # >= 1.13.3 && <
TRANS_VER="0.3.0.0"; TRANS_VER_REGEXP="0\.[23]\." # >= 0.2.* && < 0.4.*
MTL_VER="2.1.2"; MTL_VER_REGEXP="[12]\." # == 1.* || == 2.*
HTTP_VER="4000.2.4"; HTTP_VER_REGEXP="4000\.[012]\." # == 4000.0.* || 4000.1.* || 4000.2.*
-ZLIB_VER="0.5.3.3"; ZLIB_VER_REGEXP="0\.[45]\." # == 0.4.* || == 0.5.*
+ZLIB_VER="0.5.4.0"; ZLIB_VER_REGEXP="0\.[45]\." # == 0.4.* || == 0.5.*
TIME_VER="1.4.0.1" TIME_VER_REGEXP="1\.[1234]\.?" # >= 1.1 && < 1.5
RANDOM_VER="1.0.1.1" RANDOM_VER_REGEXP="1\.0\." # >= 1 && < 1.1

0 comments on commit 1d8ca45

Please sign in to comment.
Something went wrong with that request. Please try again.