Commit 1c399259 authored by ttuegel's avatar ttuegel
Browse files

Overhaul HPC support

This fixes issue #1945 and replaces pull request #1947.

These bugs in #1947 are fixed:
* The pull request no longer applied cleanly to master because of the
  Binary LocalBuildInfo patches.
* The new test cases did not put the generated HPC interface files under
  "dist/", so the files weren't cleanup up correctly.
* HPC interface files for each component need to be separated, but the
  were being combined into the same directory.

These enhancements are also implemented:
* Program coverage is now used for all components when enabled and the
  flag --enable-library-coverage has been changed to --enable-coverage.
* A helpful error message is printed if the obsolete flag
  --enable-library-coverage is used.
parents 5cf626df adcf97d4
......@@ -75,7 +75,6 @@ import Distribution.PackageDescription.Configuration
( finalizePackageDescription, mapTreeData )
import Distribution.PackageDescription.Check
( PackageCheck(..), checkPackage, checkPackageFiles )
import Distribution.Simple.Hpc ( enableCoverage )
import Distribution.Simple.Program
( Program(..), ProgramLocation(..), ConfiguredProgram(..)
, ProgramConfiguration, defaultProgramConfiguration
......@@ -85,7 +84,8 @@ import Distribution.Simple.Program
, lookupProgram, requireProgram, requireProgramVersion
, pkgConfigProgram, gccProgram, rawSystemProgramStdoutConf )
import Distribution.Simple.Setup
( ConfigFlags(..), CopyDest(..), fromFlag, fromFlagOrDefault, flagToMaybe )
( ConfigFlags(..), CopyDest(..), Flag(..), fromFlag, fromFlagOrDefault
, flagToMaybe )
import Distribution.Simple.InstallDirs
( InstallDirs(..), defaultInstallDirs, combineInstallDirs )
import Distribution.Simple.LocalBuildInfo
......@@ -294,7 +294,13 @@ localBuildInfoFile distPref = distPref </> "setup-config"
configure :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
configure (pkg_descr0, pbi) cfg
= do let distPref = fromFlag (configDistPref cfg)
= do unless (configLibCoverage cfg == NoFlag) $ do
let enable | fromFlag (configLibCoverage cfg) = "enable"
| otherwise = "disable"
die $ "Option --" ++ enable ++ "-library-coverage is obsolete! "
++ "Please use --" ++ enable ++ "-coverage instead."
let distPref = fromFlag (configDistPref cfg)
buildDir' = distPref </> "build"
verbosity = fromFlag (configVerbosity cfg)
......@@ -411,9 +417,7 @@ configure (pkg_descr0, pbi) cfg
-- add extra include/lib dirs as specified in cfg
-- we do it here so that those get checked too
let pkg_descr =
enableCoverage (fromFlag (configLibCoverage cfg)) distPref
$ addExtraIncludeLibDirs pkg_descr0'
let pkg_descr = addExtraIncludeLibDirs pkg_descr0'
when (not (null flags)) $
info verbosity $ "Flags chosen: "
......
......@@ -62,6 +62,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, LibraryName(..), absoluteInstallDirs )
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
......@@ -85,7 +86,7 @@ import qualified Distribution.Simple.Program.Ld as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
( toFlag, fromFlag, fromFlagOrDefault )
( toFlag, fromFlag, fromFlagOrDefault, configCoverage, configDistPref )
import qualified Distribution.Simple.Setup as Cabal
( Flag )
import Distribution.Simple.Compiler
......@@ -703,11 +704,22 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
forceSharedLib = doingTH && isGhcDynamic
-- TH always needs default libs, even when building for profiling
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
-- Component name. Not 'libName' because that has the "HS" prefix
-- that GHC gives Haskell libraries.
cname = display $ PD.package $ localPkgDescr lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir | isCoverageEnabled = toFlag $ Hpc.mixDir distPref cname
| otherwise = mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules?
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
`mappend` mempty { ghcOptHPCDir = hpcdir }
vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = toFlag numJobs,
......@@ -943,6 +955,13 @@ buildOrReplExe forRepl verbosity numJobsFlag _pkg_descr lbi
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules? FIX: what about exeName.hi-boot?
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir | isCoverageEnabled = toFlag $ Hpc.mixDir distPref exeName'
| otherwise = mempty
-- build executables
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
......@@ -957,7 +976,8 @@ buildOrReplExe forRepl verbosity numJobsFlag _pkg_descr lbi
ghcOptInputFiles =
[ srcMainFile | isHaskellMain],
ghcOptInputModules =
[ m | not isHaskellMain, m <- exeModules exe]
[ m | not isHaskellMain, m <- exeModules exe],
ghcOptHPCDir = hpcdir
}
staticOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticOnly
......@@ -1193,7 +1213,6 @@ componentGhcOptions verbosity lbi bi clbi odir =
toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation
toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation
componentCcGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath
......
......@@ -12,7 +12,7 @@
-- build test suites with HPC enabled.
module Distribution.Simple.Hpc
( enableCoverage
( mixDir
, htmlDir
, tixDir
, tixFilePath
......@@ -21,13 +21,9 @@ module Distribution.Simple.Hpc
) where
import Control.Monad ( when )
import Distribution.Compiler ( CompilerFlavor(..) )
import Distribution.ModuleName ( main )
import Distribution.PackageDescription
( BuildInfo(..)
, Library(..)
, PackageDescription(..)
, TestSuite(..)
( TestSuite(..)
, testModules
)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
......@@ -38,7 +34,6 @@ import Distribution.Simple.Program
import Distribution.Simple.Program.Hpc ( markup, union )
import Distribution.Simple.Utils ( notice )
import Distribution.Version ( anyVersion )
import Distribution.Text
import Distribution.Verbosity ( Verbosity() )
import System.Directory ( createDirectoryIfMissing, doesFileExist )
import System.FilePath
......@@ -46,38 +41,6 @@ import System.FilePath
-- -------------------------------------------------------------------------
-- Haskell Program Coverage
-- | Conditionally enable Haskell Program Coverage by adding the necessary
-- GHC options to a PackageDescription.
--
-- TODO: do this differently in the build stage by constructing local build
-- info, not by modifying the original PackageDescription.
--
enableCoverage :: Bool -- ^ Enable coverage?
-> String -- ^ \"dist/\" prefix
-> PackageDescription
-> PackageDescription
enableCoverage False _ x = x
enableCoverage True distPref p =
p { library = fmap enableLibCoverage (library p)
, testSuites = map enableTestCoverage (testSuites p)
}
where
enableBICoverage name oldBI =
let oldOptions = options oldBI
oldGHCOpts = lookup GHC oldOptions
newGHCOpts = case oldGHCOpts of
Just xs -> (GHC, hpcOpts ++ xs)
_ -> (GHC, hpcOpts)
newOptions = (:) newGHCOpts $ filter ((== GHC) . fst) oldOptions
hpcOpts = ["-fhpc", "-hpcdir", mixDir distPref name]
in oldBI { options = newOptions }
enableLibCoverage l =
l { libBuildInfo = enableBICoverage (display $ package p)
(libBuildInfo l)
}
enableTestCoverage t =
t { testBuildInfo = enableBICoverage (testName t) (testBuildInfo t) }
hpcDir :: FilePath -- ^ \"dist/\" prefix
-> FilePath -- ^ Directory containing component's HPC .mix files
hpcDir distPref = distPref </> "hpc"
......
......@@ -151,6 +151,9 @@ data GhcOptions = GhcOptions {
-- | Run N jobs simultaneously (if possible).
ghcOptNumJobs :: Flag Int,
-- | Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags.
ghcOptHPCDir :: Flag FilePath,
----------------
-- GHCi
......@@ -263,6 +266,9 @@ renderGhcOptions comp opts
, [ "-split-objs" | flagBool ghcOptSplitObjs ]
, case flagToMaybe (ghcOptHPCDir opts) of
Nothing -> []
Just hpcdir -> ["-fhpc", "-hpcdir", hpcdir]
, if parmakeSupported comp
then
......@@ -442,6 +448,7 @@ instance Monoid GhcOptions where
ghcOptProfilingMode = mempty,
ghcOptSplitObjs = mempty,
ghcOptNumJobs = mempty,
ghcOptHPCDir = mempty,
ghcOptGHCiScripts = mempty,
ghcOptHiSuffix = mempty,
ghcOptObjSuffix = mempty,
......@@ -491,6 +498,7 @@ instance Monoid GhcOptions where
ghcOptProfilingMode = combine ghcOptProfilingMode,
ghcOptSplitObjs = combine ghcOptSplitObjs,
ghcOptNumJobs = combine ghcOptNumJobs,
ghcOptHPCDir = combine ghcOptHPCDir,
ghcOptGHCiScripts = combine ghcOptGHCiScripts,
ghcOptHiSuffix = combine ghcOptHiSuffix,
ghcOptObjSuffix = combine ghcOptObjSuffix,
......
......@@ -296,11 +296,13 @@ data ConfigFlags = ConfigFlags {
configConfigurationsFlags :: FlagAssignment,
configTests :: Flag Bool, -- ^Enable test suite compilation
configBenchmarks :: Flag Bool, -- ^Enable benchmark compilation
configLibCoverage :: Flag Bool,
-- ^Enable test suite program coverage.
configExactConfiguration :: Flag Bool
configCoverage :: Flag Bool, -- ^Enable program coverage
configLibCoverage :: Flag Bool, -- ^OBSOLETE. Just used to signal error.
configExactConfiguration :: Flag Bool,
-- ^All direct dependencies and flags are provided on the command line by
-- the user via the '--dependency' and '--flags' options.
configFlagError :: Flag String
-- ^Halt and show an error message indicating an error in flag assignment
}
deriving (Generic, Read, Show)
......@@ -338,8 +340,10 @@ defaultConfigFlags progConf = emptyConfigFlags {
configStripLibs = Flag True,
configTests = Flag False,
configBenchmarks = Flag False,
configLibCoverage = Flag False,
configExactConfiguration = Flag False
configCoverage = Flag False,
configLibCoverage = NoFlag,
configExactConfiguration = Flag False,
configFlagError = NoFlag
}
configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags
......@@ -524,10 +528,15 @@ configureOptions showOrParseArgs =
(boolOpt [] [])
,option "" ["library-coverage"]
"build library and test suites with Haskell Program Coverage enabled. (GHC only)"
"OBSOLETE. Please use --enable-coverage instead."
configLibCoverage (\v flags -> flags { configLibCoverage = v })
(boolOpt [] [])
,option "" ["coverage"]
"build package with Haskell Program Coverage enabled. (GHC only)"
configCoverage (\v flags -> flags { configCoverage = v })
(boolOpt [] [])
,option "" ["exact-configuration"]
"All direct dependencies and flags are provided on the command line."
configExactConfiguration
......@@ -677,9 +686,11 @@ instance Monoid ConfigFlags where
configExtraIncludeDirs = mempty,
configConfigurationsFlags = mempty,
configTests = mempty,
configLibCoverage = mempty,
configCoverage = mempty,
configLibCoverage = mempty,
configExactConfiguration = mempty,
configBenchmarks = mempty
configBenchmarks = mempty,
configFlagError = mempty
}
mappend a b = ConfigFlags {
configPrograms = configPrograms b,
......@@ -714,9 +725,11 @@ instance Monoid ConfigFlags where
configExtraIncludeDirs = combine configExtraIncludeDirs,
configConfigurationsFlags = combine configConfigurationsFlags,
configTests = combine configTests,
configCoverage = combine configCoverage,
configLibCoverage = combine configLibCoverage,
configExactConfiguration = combine configExactConfiguration,
configBenchmarks = combine configBenchmarks
configBenchmarks = combine configBenchmarks,
configFlagError = combine configFlagError
}
where combine field = field a `mappend` field b
......
......@@ -26,7 +26,7 @@ import Distribution.Simple.InstallDirs
, PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
( LocalBuildInfo(..) )
import Distribution.Simple.Setup ( TestFlags(..), fromFlag )
import Distribution.Simple.Setup ( TestFlags(..), fromFlag, configCoverage )
import Distribution.Simple.UserHooks ( Args )
import qualified Distribution.Simple.Test.ExeV10 as ExeV10
import qualified Distribution.Simple.Test.LibV09 as LibV09
......@@ -117,8 +117,10 @@ test args pkg_descr lbi flags = do
allOk <- summarizePackage verbosity packageLog
writeFile packageLogFile $ show packageLog
markupPackage verbosity lbi distPref (display $ PD.package pkg_descr)
$ map fst testsToRun
let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi
when isCoverageEnabled $
markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) $
map fst testsToRun
unless allOk exitFailure
......
......@@ -13,7 +13,8 @@ import Distribution.Simple.InstallDirs
( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
, substPathTemplate , toPathTemplate, PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag )
import Distribution.Simple.Setup
( TestFlags(..), TestShowDetails(..), fromFlag, configCoverage )
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
import Distribution.TestSuite
......@@ -35,6 +36,8 @@ runTest :: PD.PackageDescription
-> PD.TestSuite
-> IO TestSuiteLog
runTest pkg_descr lbi flags suite = do
let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi
pwd <- getCurrentDirectory
existingEnv <- getEnvironment
......@@ -71,10 +74,10 @@ runTest pkg_descr lbi flags suite = do
let opts = map (testOption pkg_descr lbi suite)
(testOptions flags)
dataDirPath = pwd </> PD.dataDir pkg_descr
tixFile = pwd </> (tixFilePath distPref $ PD.testName suite)
shellEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: ("HPCTIXFILE", tixFile)
tixFile = pwd </> tixFilePath distPref (PD.testName suite)
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isCoverageEnabled] ++ pkgPathEnv
exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
-- these handles are automatically closed
Nothing (Just wOut) (Just wOut)
......@@ -107,8 +110,8 @@ runTest pkg_descr lbi flags suite = do
-- Write summary notice to terminal indicating end of test suite
notice verbosity $ summarizeSuiteFinish suiteLog
markupTest verbosity lbi distPref
(display $ PD.package pkg_descr) suite
when isCoverageEnabled $
markupTest verbosity lbi distPref (display $ PD.package pkg_descr) suite
return suiteLog
where
......
......@@ -19,7 +19,8 @@ import Distribution.Simple.InstallDirs
( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
, substPathTemplate , toPathTemplate, PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag )
import Distribution.Simple.Setup
( TestFlags(..), TestShowDetails(..), fromFlag, configCoverage )
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
import Distribution.TestSuite
......@@ -43,6 +44,8 @@ runTest :: PD.PackageDescription
-> PD.TestSuite
-> IO TestSuiteLog
runTest pkg_descr lbi flags suite = do
let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi
pwd <- getCurrentDirectory
existingEnv <- getEnvironment
......@@ -78,10 +81,11 @@ runTest pkg_descr lbi flags suite = do
-- Run test executable
_ <- do let opts = map (testOption pkg_descr lbi suite) $ testOptions flags
dataDirPath = pwd </> PD.dataDir pkg_descr
shellEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: ("HPCTIXFILE", (</>) pwd
$ tixFilePath distPref $ PD.testName suite)
tixFile = pwd </> tixFilePath distPref (PD.testName suite)
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isCoverageEnabled]
++ pkgPathEnv
rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
-- these handles are closed automatically
(Just rIn) (Just wOut) (Just wOut)
......@@ -120,8 +124,8 @@ runTest pkg_descr lbi flags suite = do
-- Write summary notice to terminal indicating end of test suite
notice verbosity $ summarizeSuiteFinish suiteLog
markupTest verbosity lbi distPref
(display $ PD.package pkg_descr) suite
when isCoverageEnabled $
markupTest verbosity lbi distPref (display $ PD.package pkg_descr) suite
return suiteLog
where
......
......@@ -24,7 +24,7 @@ module Distribution.Simple.Utils (
topHandler, topHandlerWith,
warn, notice, setupMessage, info, debug,
debugNoWrap, chattyTry,
printRawCommandAndArgs,
printRawCommandAndArgs, printRawCommandAndArgsAndEnv,
-- * running programs
rawSystemExit,
......@@ -333,20 +333,19 @@ maybeExit cmd = do
unless (res == ExitSuccess) $ exitWith res
printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO ()
printRawCommandAndArgs verbosity path args
| verbosity >= deafening = print (path, args)
| verbosity >= verbose = putStrLn $ showCommandForUser path args
| otherwise = return ()
printRawCommandAndArgs verbosity path args =
printRawCommandAndArgsAndEnv verbosity path args Nothing
printRawCommandAndArgsAndEnv :: Verbosity
-> FilePath
-> [String]
-> [(String, String)]
-> Maybe [(String, String)]
-> IO ()
printRawCommandAndArgsAndEnv verbosity path args env
| verbosity >= deafening = do putStrLn ("Environment: " ++ show env)
print (path, args)
| verbosity >= verbose = putStrLn $ unwords (path : args)
printRawCommandAndArgsAndEnv verbosity path args menv
| verbosity >= deafening = do
maybe (return ()) (putStrLn . ("Environment: " ++) . show) menv
print (path, args)
| verbosity >= verbose = putStrLn $ showCommandForUser path args
| otherwise = return ()
......@@ -375,7 +374,7 @@ rawSystemExitWithEnv :: Verbosity
-> [(String, String)]
-> IO ()
rawSystemExitWithEnv verbosity path args env = do
printRawCommandAndArgsAndEnv verbosity path args env
printRawCommandAndArgsAndEnv verbosity path args (Just env)
hFlush stdout
(_,_,_,ph) <- createProcess $
(Process.proc path args) { Process.env = (Just env)
......@@ -403,8 +402,7 @@ rawSystemIOWithEnv :: Verbosity
-> Maybe Handle -- ^ stderr
-> IO ExitCode
rawSystemIOWithEnv verbosity path args mcwd menv inp out err = do
maybe (printRawCommandAndArgs verbosity path args)
(printRawCommandAndArgsAndEnv verbosity path args) menv
printRawCommandAndArgsAndEnv verbosity path args menv
hFlush stdout
(_,_,_,ph) <- createProcess $
(Process.proc path args) { Process.cwd = mcwd
......
......@@ -80,6 +80,10 @@ tests version inplaceSpec ghcPath ghcPkgPath =
, hunit "TestSuiteExeV10/Test" (PackageTests.TestSuiteExeV10.Check.checkTest ghcPath)
, hunit "TestSuiteExeV10/TestWithHpc"
(PackageTests.TestSuiteExeV10.Check.checkTestWithHpc ghcPath)
, hunit "TestSuiteExeV10/TestWithoutHpcNoTix"
(PackageTests.TestSuiteExeV10.Check.checkTestWithoutHpcNoTix ghcPath)
, hunit "TestSuiteExeV10/TestWithoutHpcNoMarkup"
(PackageTests.TestSuiteExeV10.Check.checkTestWithoutHpcNoMarkup ghcPath)
, hunit "TestOptions" (PackageTests.TestOptions.Check.suite ghcPath)
, hunit "BenchmarkStanza" (PackageTests.BenchmarkStanza.Check.suite ghcPath)
-- ^ The benchmark stanza test will eventually be required
......
......@@ -18,7 +18,7 @@ suite ghcPath ghcPkgPath = TestCase $ do
assertBuildSucceeded bResult
unregister "InternalLibrary2" ghcPkgPath
(_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") []
(_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") [] []
C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
assertEqual "executable should have linked with the internal library" "myLibFunc internal" (concat $ lines output)
......@@ -18,7 +18,7 @@ suite ghcPath ghcPkgPath = TestCase $ do
assertBuildSucceeded bResult
unregister "InternalLibrary3"ghcPkgPath
(_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") []
(_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") [] []
C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
assertEqual "executable should have linked with the internal library" "myLibFunc internal" (concat $ lines output)
......@@ -18,7 +18,7 @@ suite ghcPath ghcPkgPath = TestCase $ do
assertBuildSucceeded bResult
unregister "InternalLibrary4" ghcPkgPath
(_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") []
(_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") [] []
C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
assertEqual "executable should have linked with the installed library" "myLibFunc installed" (concat $ lines output)
......@@ -22,7 +22,7 @@ assertFailure' msg = assertFailure msg >> return {-unpossible!-}undefined
ghcPkg_field :: String -> String -> FilePath -> IO [FilePath]
ghcPkg_field libraryName fieldName ghcPkgPath = do
(cmd, exitCode, raw) <- run Nothing ghcPkgPath
(cmd, exitCode, raw) <- run Nothing ghcPkgPath []
["--user", "field", libraryName, fieldName]
let output = filter ('\r' /=) raw -- Windows
-- copypasta of PackageTester.requireSuccess
......
......@@ -37,14 +37,15 @@ import System.Directory (canonicalizePath, doesFileExist, getCurrentDirectory)
import System.Environment (getEnv)
import System.Exit (ExitCode(ExitSuccess))
import System.FilePath
import System.IO
import System.IO (hIsEOF, hGetChar, hClose)
import System.IO.Error (isDoesNotExistError)
import System.Process (runProcess, waitForProcess)
import Test.HUnit (Assertion, assertFailure)
import Distribution.Simple.BuildPaths (exeExtension)
import Distribution.Simple.Utils (printRawCommandAndArgs)
import Distribution.Compat.CreatePipe (createPipe)
import Distribution.Simple.BuildPaths (exeExtension)
import Distribution.Simple.Program.Run (getEffectiveEnvironment)
import Distribution.Simple.Utils (printRawCommandAndArgsAndEnv)
import Distribution.ReadE (readEOrFail)
import Distribution.Verbosity (Verbosity, flagToVerbosity, normal)
......@@ -92,9 +93,9 @@ cabal_configure spec ghcPath = do
doCabalConfigure :: PackageSpec -> FilePath -> IO Result
doCabalConfigure spec ghcPath = do
cleanResult@(_, _, _) <- cabal spec ["clean"] ghcPath
cleanResult@(_, _, _) <- cabal spec [] ["clean"] ghcPath
requireSuccess cleanResult
res <- cabal spec
res <- cabal spec []
(["configure", "--user", "-w", ghcPath] ++ configOpts spec)
ghcPath
return $ recordRun res ConfigureSuccess nullResult
......@@ -104,7 +105,7 @@ doCabalBuild spec ghcPath = do
configResult <- doCabalConfigure spec ghcPath
if successful configResult
then do
res <- cabal spec ["build", "-v"] ghcPath
res <- cabal spec [] ["build", "-v"] ghcPath
return $ recordRun res BuildSuccess configResult
else
return configResult
......@@ -126,14 +127,14 @@ doCabalHaddock spec extraArgs ghcPath = do
configResult <- doCabalConfigure spec ghcPath
if successful configResult
then do
res <- cabal spec ("haddock" : extraArgs) ghcPath
res <- cabal spec [] ("haddock" : extraArgs) ghcPath
return $ recordRun res HaddockSuccess configResult
else
return configResult
unregister :: String -> FilePath -> IO ()
unregister libraryName ghcPkgPath = do
res@(_, _, output) <- run Nothing ghcPkgPath ["unregister", "--user", libraryName]
res@(_, _, output) <- run Nothing ghcPkgPath [] ["unregister", "--user", libraryName]
if "cannot find package" `isInfixOf` output
then return ()
else requireSuccess res
......@@ -144,23 +145,23 @@ cabal_install spec ghcPath = do
buildResult <- doCabalBuild spec ghcPath
res <- if successful buildResult
then do
res <- cabal spec ["install"] ghcPath
res <- cabal spec [] ["install"] ghcPath
return $ recordRun res InstallSuccess buildResult
else
return buildResult
record spec res
return res
cabal_test :: PackageSpec -> [String] -> FilePath -> IO Result
cabal_test spec extraArgs ghcPath = do
res <- cabal spec ("test" : extraArgs) ghcPath
cabal_test :: PackageSpec -> [(String, Maybe String)] -> [String] -> FilePath -> IO Result
cabal_test spec envOverrides extraArgs ghcPath = do
res <- cabal spec envOverrides ("test" : extraArgs) ghcPath
let r = recordRun res TestSuccess nullResult
record spec r
return r
cabal_bench :: PackageSpec -> [String] -> FilePath -> IO Result
cabal_bench spec extraArgs ghcPath = do
res <- cabal spec ("bench" : extraArgs) ghcPath
res <- cabal spec [] ("bench" : extraArgs) ghcPath
let r = recordRun res BenchSuccess nullResult
record spec r
return r
......@@ -168,7 +169,7 @@ cabal_bench spec extraArgs ghcPath = do
compileSetup :: FilePath -> FilePath -> IO ()
compileSetup packageDir ghcPath = do
wd <- getCurrentDirectory
r <- run (Just $ packageDir) ghcPath
r <- run (Just $ packageDir) ghcPath []
[ "--make"
-- HPC causes trouble -- see #1012