diff --git a/Cabal/Distribution/Simple/Program/Db.hs b/Cabal/Distribution/Simple/Program/Db.hs
index d15368d6e16ddf86ab471b31dd49fd1d000dd783..18c35ce9b0956e8df46f0cea3af69993023a9bcc 100644
--- a/Cabal/Distribution/Simple/Program/Db.hs
+++ b/Cabal/Distribution/Simple/Program/Db.hs
@@ -52,6 +52,7 @@ module Distribution.Simple.Program.Db (
-- ** Query and manipulate the program db
configureProgram,
configureAllKnownPrograms,
+ unconfigureProgram,
lookupProgramVersion,
reconfigurePrograms,
requireProgram,
@@ -365,6 +366,13 @@ configurePrograms verbosity progs progdb =
foldM (flip (configureProgram verbosity)) progdb progs
+-- | Unconfigure a program. This is basically a hack and you shouldn't
+-- use it, but it can be handy for making sure a 'requireProgram'
+-- actually reconfigures.
+unconfigureProgram :: String -> ProgramDb -> ProgramDb
+unconfigureProgram progname =
+ updateConfiguredProgs $ Map.delete progname
+
-- | Try to configure all the known programs that have not yet been configured.
--
configureAllKnownPrograms :: Verbosity
diff --git a/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs b/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs
index 5bf979e68211f63013799cdb126d698414800542..dee03490f88c31a2e9c23f2175c4b34937306842 100644
--- a/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs
+++ b/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs
@@ -1,5 +1,7 @@
import Test.Cabal.Prelude
import Data.Maybe
+import System.Directory
+import Control.Monad.IO.Class
main = cabalTest $ do
withPackageDb $ do
withSandbox $ do
@@ -10,9 +12,10 @@ main = cabalTest $ do
-- When run inside 'cabal-exec' the 'sandbox hc-pkg list' sub-command
-- should find the library.
env <- getTestEnv
- -- TODO: libify me
- let cabal_path = fromMaybe (error "No cabal-install path configured")
- (testCabalInstallPath env)
+ -- NB: cabal_path might be relative, so we have to
+ -- turn it absolute
+ rel_cabal_path <- programPathM cabalProgram
+ cabal_path <- liftIO $ makeAbsolute rel_cabal_path
cabal' "exec" ["sh", "--", "-c"
, "cd subdir && " ++ show cabal_path ++
-- TODO: Ugh. Test abstractions leaking
diff --git a/cabal-testsuite/Test/Cabal/Monad.hs b/cabal-testsuite/Test/Cabal/Monad.hs
index dd872f56ed6d072a4d4334e00fc36d28a2f30b77..46e85d60c1ed8f17b67d9e951610010c92887a10 100644
--- a/cabal-testsuite/Test/Cabal/Monad.hs
+++ b/cabal-testsuite/Test/Cabal/Monad.hs
@@ -12,6 +12,9 @@ module Test.Cabal.Monad (
-- * Helper functions
programPathM,
requireProgramM,
+ isAvailableProgram,
+ hackageRepoToolProgram,
+ cabalProgram,
-- * The test environment
TestEnv(..),
getTestEnv,
@@ -54,7 +57,6 @@ import Distribution.Simple.Configure
( getPersistBuildConfig, configCompilerEx )
import Distribution.Types.LocalBuildInfo
-
import Distribution.Verbosity
import qualified Control.Exception as E
@@ -71,10 +73,10 @@ import System.IO.Error (isDoesNotExistError)
import Options.Applicative
data CommonArgs = CommonArgs {
- argCabalInstallPath :: Maybe FilePath,
- argGhcPath :: Maybe FilePath,
- argHackageRepoToolPath :: FilePath,
- argSkipSetupTests :: Bool
+ argCabalInstallPath :: Maybe FilePath,
+ argGhcPath :: Maybe FilePath,
+ argHackageRepoToolPath :: Maybe FilePath,
+ argSkipSetupTests :: Bool
}
commonArgParser :: Parser CommonArgs
@@ -90,25 +92,24 @@ commonArgParser = CommonArgs
<> long "with-ghc"
<> metavar "PATH"
))
- <*> option str
+ <*> optional (option str
( help "Path to hackage-repo-tool to use for repository manipulation"
<> long "with-hackage-repo-tool"
<> metavar "PATH"
- <> value "hackage-repo-tool"
- )
+ ))
<*> switch (long "skip-setup-tests" <> help "Skip setup tests")
renderCommonArgs :: CommonArgs -> [String]
renderCommonArgs args =
- maybe [] (\x -> ["--with-cabal", x]) (argCabalInstallPath args) ++
- maybe [] (\x -> ["--with-ghc", x]) (argGhcPath args) ++
- ["--with-hackage-repo-tool", argHackageRepoToolPath args] ++
+ maybe [] (\x -> ["--with-cabal", x]) (argCabalInstallPath args) ++
+ maybe [] (\x -> ["--with-ghc", x]) (argGhcPath args) ++
+ maybe [] (\x -> ["--with-hackage-repo-tool", x]) (argHackageRepoToolPath args) ++
(if argSkipSetupTests args then ["--skip-setup-tests"] else [])
data TestArgs = TestArgs {
- testArgDistDir :: FilePath,
+ testArgDistDir :: FilePath,
testArgScriptPath :: FilePath,
- testCommonArgs :: CommonArgs
+ testCommonArgs :: CommonArgs
}
testArgParser :: Parser TestArgs
@@ -153,15 +154,14 @@ unexpectedSuccessExitCode = 66
setupAndCabalTest :: TestM () -> IO ()
setupAndCabalTest m = runTestM $ do
env <- getTestEnv
- skipIf (testSkipSetupTests env && isNothing (testCabalInstallPath env))
+ have_cabal <- isAvailableProgram cabalProgram
+ skipIf (testSkipSetupTests env && not have_cabal)
when (not (testSkipSetupTests env)) $ do
liftIO $ putStrLn "Test with Setup:"
m
- case testCabalInstallPath env of
- Nothing -> return ()
- Just _ -> do
- liftIO $ putStrLn "Test with cabal-install:"
- withReaderT (\nenv -> nenv { testCabalInstallAsSetup = True }) m
+ when have_cabal $ do
+ liftIO $ putStrLn "Test with cabal-install:"
+ withReaderT (\nenv -> nenv { testCabalInstallAsSetup = True }) m
setupTest :: TestM () -> IO ()
setupTest m = runTestM $ do
@@ -171,12 +171,20 @@ setupTest m = runTestM $ do
cabalTest :: TestM () -> IO ()
cabalTest m = runTestM $ do
- env <- getTestEnv
- skipIf (isNothing (testCabalInstallPath env))
+ skipUnless =<< isAvailableProgram cabalProgram
withReaderT (\nenv -> nenv { testCabalInstallAsSetup = True }) m
type TestM = ReaderT TestEnv IO
+hackageRepoToolProgram :: Program
+hackageRepoToolProgram = simpleProgram "hackage-repo-tool"
+
+cabalProgram :: Program
+cabalProgram = (simpleProgram "cabal") {
+ -- Do NOT search for executable named cabal
+ programFindLocation = \_ _ -> return Nothing
+ }
+
-- | Run a test in the test monad according to program's arguments.
runTestM :: TestM () -> IO ()
runTestM m = do
@@ -189,20 +197,61 @@ runTestM m = do
lbi <- getPersistBuildConfig dist_dir
let verbosity = normal -- TODO: configurable
senv <- mkScriptEnv verbosity lbi
- (program_db, db_stack) <- case argGhcPath (testCommonArgs args) of
- Nothing -> return (withPrograms lbi, withPackageDB lbi)
+ -- Add test suite specific programs
+ let program_db0 =
+ addKnownPrograms
+ ([hackageRepoToolProgram, cabalProgram] ++ builtinPrograms)
+ (withPrograms lbi)
+ -- Reconfigure according to user flags
+ let cargs = testCommonArgs args
+ program_db1 <-
+ reconfigurePrograms verbosity
+ ([("cabal", p) | p <- maybeToList (argCabalInstallPath cargs)] ++
+ [("ghc", p) | p <- maybeToList (argGhcPath cargs)] ++
+ [("hackage-repo-tool", p)
+ | p <- maybeToList (argHackageRepoToolPath cargs)])
+ [] -- --prog-options not supported ATM
+ program_db0
+
+ -- Reconfigure the rest of GHC
+ program_db <- case argGhcPath cargs of
+ Nothing -> return program_db1
Just ghc_path -> do
+ -- All the things that get updated paths from
+ -- configCompilerEx. The point is to make sure
+ -- we reconfigure these when we need them.
+ let program_db2 = unconfigureProgram "ghc"
+ . unconfigureProgram "ghc-pkg"
+ . unconfigureProgram "hsc2hs"
+ . unconfigureProgram "haddock"
+ . unconfigureProgram "hpc"
+ . unconfigureProgram "runghc"
+ . unconfigureProgram "gcc"
+ . unconfigureProgram "ld"
+ . unconfigureProgram "ar"
+ . unconfigureProgram "strip"
+ $ program_db1
(_, _, program_db) <-
configCompilerEx
(Just (compilerFlavor (compiler lbi)))
(Just ghc_path)
Nothing
- defaultProgramDb -- don't use lbi; it won't reconfigure
+ program_db2
verbosity
- -- TODO: configurable
- let db_stack = [GlobalPackageDB]
- return (program_db, db_stack)
- let env = TestEnv {
+ -- TODO: this actually leaves a pile of things unconfigured.
+ -- Optimal strategy for us is to lazily configure them, so
+ -- we don't pay for things we don't need. A bit difficult
+ -- to do in the current design.
+ return program_db
+
+ let db_stack =
+ case argGhcPath (testCommonArgs args) of
+ Nothing -> withPackageDB lbi
+ -- Can't use the build package db stack since they
+ -- are all for the wrong versions! TODO: Make
+ -- this configurable
+ Just _ -> [GlobalPackageDB]
+ env = TestEnv {
testSourceDir = script_dir,
testSubName = script_base,
testProgramDb = program_db,
@@ -211,8 +260,6 @@ runTestM m = do
testMtimeChangeDelay = Nothing,
testScriptEnv = senv,
testSetupPath = dist_dir </> "setup" </> "setup",
- testCabalInstallPath = argCabalInstallPath (testCommonArgs args),
- testHackageRepoToolPath = argHackageRepoToolPath (testCommonArgs args),
testSkipSetupTests = argSkipSetupTests (testCommonArgs args),
testEnvironment =
-- Try to avoid Unicode output
@@ -253,6 +300,18 @@ programPathM :: Program -> TestM FilePath
programPathM program = do
fmap programPath (requireProgramM program)
+isAvailableProgram :: Program -> TestM Bool
+isAvailableProgram program = do
+ env <- getTestEnv
+ case lookupProgram program (testProgramDb env) of
+ Just _ -> return True
+ Nothing -> do
+ -- It might not have been configured. Try to configure.
+ progdb <- liftIO $ configureProgram (testVerbosity env) program (testProgramDb env)
+ case lookupProgram program progdb of
+ Just _ -> return True
+ Nothing -> return False
+
-- | Run an IO action, and suppress a "does not exist" error.
onlyIfExists :: MonadIO m => IO () -> m ()
onlyIfExists m =
@@ -285,13 +344,6 @@ data TestEnv = TestEnv
, testScriptEnv :: ScriptEnv
-- | Setup script path
, testSetupPath :: FilePath
- -- | cabal-install path (or Nothing if we are not testing
- -- cabal-install). NB: This does NOT default to @cabal@ in PATH as
- -- this is unlikely to be the cabal you want to test.
- , testCabalInstallPath :: Maybe FilePath
- -- | hackage-repo-tool path (defaults to hackage-repo-tool found in
- -- PATH)
- , testHackageRepoToolPath :: FilePath
-- | Skip Setup tests?
, testSkipSetupTests :: Bool
diff --git a/cabal-testsuite/Test/Cabal/Prelude.hs b/cabal-testsuite/Test/Cabal/Prelude.hs
index dc0889ae41913b42156a4c2b57b9e94bc1f5b5d3..6e068c697479758279f0729aa4d7224f183b0cbb 100644
--- a/cabal-testsuite/Test/Cabal/Prelude.hs
+++ b/cabal-testsuite/Test/Cabal/Prelude.hs
@@ -135,8 +135,7 @@ setup' cmd args = do
full_args = cmd : ["-v", "--distdir", rel_dist_dir] ++ args'
r <-
if testCabalInstallAsSetup env
- then runM (fromMaybe (error "No cabal-install path configured")
- (testCabalInstallPath env)) full_args
+ then runProgramM cabalProgram full_args
else do
pdfile <- liftIO $ tryFindPackageDesc (testCurrentDir env)
pdesc <- liftIO $ readPackageDescription (testVerbosity env) pdfile
@@ -262,13 +261,7 @@ cabal_sandbox' cmd args = do
cabal_raw' :: [String] -> TestM Result
cabal_raw' cabal_args = do
- env <- getTestEnv
- r <- liftIO $ run (testVerbosity env)
- (Just (testCurrentDir env))
- (testEnvironment env)
- (fromMaybe (error "No cabal-install path configured")
- (testCabalInstallPath env))
- cabal_args
+ r <- runProgramM cabalProgram cabal_args
record r
requireSuccess r
@@ -426,8 +419,7 @@ hackageRepoTool cmd args = void $ hackageRepoTool' cmd args
hackageRepoTool' :: String -> [String] -> TestM Result
hackageRepoTool' cmd args = do
- env <- getTestEnv
- r <- runM (testHackageRepoToolPath env) (cmd : args)
+ r <- runProgramM hackageRepoToolProgram (cmd : args)
record r
_ <- requireSuccess r
return r
@@ -456,6 +448,10 @@ infixr 4 `archiveTo`
withRepo :: FilePath -> TestM a -> TestM a
withRepo repo_dir m = do
env <- getTestEnv
+
+ -- Check if hackage-repo-tool is available, and skip if not
+ skipUnless =<< isAvailableProgram hackageRepoToolProgram
+
-- 1. Generate keys
hackageRepoTool "create-keys" ["--keys", testKeysDir env]
-- 2. Initialize repo directory