Commit be67c424 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #2190 from lspitzner/tests

cabal-install: Fix PackageTests using user's config
parents 89b3da21 96f806ae
......@@ -20,8 +20,17 @@ import Distribution.Verbosity (normal)
-- Third party modules.
import qualified Control.Exception.Extensible as E
import System.Directory
(canonicalizePath, getCurrentDirectory, setCurrentDirectory)
( canonicalizePath, getCurrentDirectory, setCurrentDirectory
, removeFile, doesFileExist )
import System.FilePath ((</>))
import Test.Framework (Test, defaultMain, testGroup)
import Control.Monad ( when )
-- Module containing common test code.
import PackageTests.PackageTester ( TestsPaths(..)
, packageTestsDirectory
, packageTestsConfigFile )
-- Modules containing the tests.
import qualified PackageTests.Exec.Check
......@@ -30,11 +39,11 @@ import qualified PackageTests.MultipleSource.Check
-- List of tests to run. Each test will be called with the path to the
-- cabal binary to use.
tests :: FilePath -> FilePath -> [Test]
tests cabalPath ghcPkgPath =
[ testGroup "Freeze" $ PackageTests.Freeze.Check.tests cabalPath
, testGroup "Exec" $ PackageTests.Exec.Check.tests cabalPath ghcPkgPath
, testGroup "MultipleSource" $ PackageTests.MultipleSource.Check.tests cabalPath
tests :: PackageTests.PackageTester.TestsPaths -> [Test]
tests paths =
[ testGroup "Freeze" $ PackageTests.Freeze.Check.tests paths
, testGroup "Exec" $ PackageTests.Exec.Check.tests paths
, testGroup "MultipleSource" $ PackageTests.MultipleSource.Check.tests paths
]
cabalProgram :: Program
......@@ -48,16 +57,32 @@ main = do
let programSearchPath = ProgramSearchPathDir buildDir : defaultProgramSearchPath
(cabal, _) <- requireProgram normal cabalProgram
(setProgramSearchPath programSearchPath defaultProgramDb)
let cabalPath = programPath cabal
(ghcPkg, _) <- requireProgram normal ghcPkgProgram defaultProgramDb
let ghcPkgPath = programPath ghcPkg
putStrLn $ "Using cabal: " ++ cabalPath
putStrLn $ "Using ghc-pkg: " ++ ghcPkgPath
canonicalConfigPath <- canonicalizePath $ "tests" </> packageTestsDirectory
let testsPaths = TestsPaths {
cabalPath = programPath cabal,
ghcPkgPath = programPath ghcPkg,
configPath = canonicalConfigPath </> packageTestsConfigFile
}
putStrLn $ "Using cabal: " ++ cabalPath testsPaths
putStrLn $ "Using ghc-pkg: " ++ ghcPkgPath testsPaths
cwd <- getCurrentDirectory
let confFile = packageTestsDirectory </> "cabal-config"
removeConf = do
b <- doesFileExist confFile
when b $ removeFile confFile
let runTests = do
setCurrentDirectory "tests"
defaultMain $ tests cabalPath ghcPkgPath
-- Change back to the old working directory so that the tests can be
-- repeatedly run in `cabal repl` via `:main`.
runTests `E.finally` setCurrentDirectory cwd
removeConf -- assert that there is no existing config file
-- (we want deterministic testing with the default
-- config values)
defaultMain $ tests testsPaths
runTests `E.finally` do
-- remove the default config file that got created by the tests
removeConf
-- Change back to the old working directory so that the tests can be
-- repeatedly run in `cabal repl` via `:main`.
setCurrentDirectory cwd
......@@ -16,16 +16,16 @@ import System.FilePath ((</>))
import System.Directory (getDirectoryContents)
dir :: FilePath
dir = "PackageTests" </> "Exec"
dir = packageTestsDirectory </> "Exec"
tests :: FilePath -> FilePath -> [TF.Test]
tests cabalPath ghcPkgPath =
tests :: TestsPaths -> [TF.Test]
tests paths =
[ testCase "exits with failure if given no argument" $ do
result <- cabal_exec dir [] cabalPath
result <- cabal_exec paths dir []
assertExecFailed result
, testCase "prints error message if given no argument" $ do
result <- cabal_exec dir [] cabalPath
result <- cabal_exec paths dir []
assertExecFailed result
let output = outputText result
expected = "specify an executable to run"
......@@ -35,7 +35,7 @@ tests cabalPath ghcPkgPath =
expected `isInfixOf` (intercalate " " . lines $ output)
, testCase "runs the given command" $ do
result <- cabal_exec dir ["echo", "this", "string"] cabalPath
result <- cabal_exec paths dir ["echo", "this", "string"]
assertExecSucceeded result
let output = outputText result
expected = "this string"
......@@ -49,11 +49,11 @@ tests cabalPath ghcPkgPath =
-- executable cannot be found. Creating a new sandbox. Installing
-- the executable and checking it can be run.
cleanPreviousBuilds cabalPath
assertMyExecutableNotFound cabalPath
assertPackageInstall cabalPath
cleanPreviousBuilds paths
assertMyExecutableNotFound paths
assertPackageInstall paths
result <- cabal_exec dir ["my-executable"] cabalPath
result <- cabal_exec paths dir ["my-executable"]
assertExecSucceeded result
let output = outputText result
expected = "This is my-executable"
......@@ -62,11 +62,11 @@ tests cabalPath ghcPkgPath =
expected `isInfixOf` (intercalate " " . lines $ output)
, testCase "adds the sandbox bin directory to the PATH" $ do
cleanPreviousBuilds cabalPath
assertMyExecutableNotFound cabalPath
assertPackageInstall cabalPath
cleanPreviousBuilds paths
assertMyExecutableNotFound paths
assertPackageInstall paths
result <- cabal_exec dir ["bash", "--", "-c", "my-executable"] cabalPath
result <- cabal_exec paths dir ["bash", "--", "-c", "my-executable"]
assertExecSucceeded result
let output = outputText result
expected = "This is my-executable"
......@@ -77,12 +77,12 @@ tests cabalPath ghcPkgPath =
, testCase "configures GHC to use the sandbox" $ do
let libNameAndVersion = "my-0.1"
cleanPreviousBuilds cabalPath
assertPackageInstall cabalPath
cleanPreviousBuilds paths
assertPackageInstall paths
assertMyLibIsNotAvailableOutsideofSandbox ghcPkgPath libNameAndVersion
assertMyLibIsNotAvailableOutsideofSandbox paths libNameAndVersion
result <- cabal_exec dir ["ghc-pkg", "list"] cabalPath
result <- cabal_exec paths dir ["ghc-pkg", "list"]
assertExecSucceeded result
let output = outputText result
errMsg = "my library should have been found"
......@@ -94,25 +94,24 @@ tests cabalPath ghcPkgPath =
-- , testCase "configures cabal to use the sandbox" $ do
]
cleanPreviousBuilds :: FilePath -> IO ()
cleanPreviousBuilds cabalPath = do
cleanPreviousBuilds :: TestsPaths -> IO ()
cleanPreviousBuilds paths = do
sandboxExists <- not . null . filter (== "cabal.sandbox.config") <$>
getDirectoryContents dir
assertCleanSucceeded =<< cabal_clean dir [] cabalPath
assertCleanSucceeded =<< cabal_clean paths dir []
when sandboxExists $ do
assertSandboxSucceeded =<< cabal_sandbox dir ["delete"] cabalPath
assertSandboxSucceeded =<< cabal_sandbox paths dir ["delete"]
assertPackageInstall :: FilePath -> IO ()
assertPackageInstall cabalPath = do
assertSandboxSucceeded =<< cabal_sandbox dir ["init"] cabalPath
assertInstallSucceeded =<< cabal_install dir [] cabalPath
assertPackageInstall :: TestsPaths -> IO ()
assertPackageInstall paths = do
assertSandboxSucceeded =<< cabal_sandbox paths dir ["init"]
assertInstallSucceeded =<< cabal_install paths dir []
assertMyExecutableNotFound :: FilePath -> IO ()
assertMyExecutableNotFound cabalPath = do
result <- cabal_exec dir ["my-executable"] cabalPath
assertMyExecutableNotFound :: TestsPaths -> IO ()
assertMyExecutableNotFound paths = do
result <- cabal_exec paths dir ["my-executable"]
assertExecFailed result
let output = outputText result
expected = "cabal: The program 'my-executable' is required but it " ++
......@@ -123,8 +122,8 @@ assertMyExecutableNotFound cabalPath = do
assertMyLibIsNotAvailableOutsideofSandbox :: FilePath -> String -> IO ()
assertMyLibIsNotAvailableOutsideofSandbox ghcPkgPath libNameAndVersion = do
(_, _, output) <- run (Just $ dir) ghcPkgPath ["list"]
assertMyLibIsNotAvailableOutsideofSandbox :: TestsPaths -> String -> IO ()
assertMyLibIsNotAvailableOutsideofSandbox paths libNameAndVersion = do
(_, _, output) <- run (Just $ dir) (ghcPkgPath paths) ["list"]
assertBool "my library should not have been found" $ not $
libNameAndVersion `isInfixOf` (intercalate " " . lines $ output)
......@@ -17,18 +17,18 @@ import System.FilePath ((</>))
import System.IO.Error (isDoesNotExistError)
dir :: FilePath
dir = "PackageTests" </> "Freeze"
dir = packageTestsDirectory </> "Freeze"
tests :: FilePath -> [TF.Test]
tests cabalPath =
tests :: TestsPaths -> [TF.Test]
tests paths =
[ testCase "runs without error" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
, testCase "freezes direct dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen base\n" ++ c) $
......@@ -36,7 +36,7 @@ tests cabalPath =
, testCase "freezes transitory dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen ghc-prim\n" ++ c) $
......@@ -46,7 +46,7 @@ tests cabalPath =
-- XXX Test this against a package installed in the sandbox but
-- not depended upon.
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen exceptions\n" ++ c) $ not $
......@@ -54,7 +54,7 @@ tests cabalPath =
, testCase "does not include a constraint for the package being frozen" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen self\n" ++ c) $ not $
......@@ -62,14 +62,14 @@ tests cabalPath =
, testCase "--dry-run does not modify the cabal.config file" $ do
removeCabalConfig
result <- cabal_freeze dir ["--dry-run"] cabalPath
result <- cabal_freeze paths dir ["--dry-run"]
assertFreezeSucceeded result
c <- doesFileExist $ dir </> "cabal.config"
assertBool "cabal.config file should not have been created" (not c)
, testCase "--enable-tests freezes test dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--enable-tests"] cabalPath
result <- cabal_freeze paths dir ["--enable-tests"]
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen test-framework\n" ++ c) $
......@@ -77,7 +77,7 @@ tests cabalPath =
, testCase "--disable-tests does not freeze test dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-tests"] cabalPath
result <- cabal_freeze paths dir ["--disable-tests"]
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen test-framework\n" ++ c) $ not $
......@@ -85,7 +85,7 @@ tests cabalPath =
, testCase "--enable-benchmarks freezes benchmark dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-benchmarks"] cabalPath
result <- cabal_freeze paths dir ["--disable-benchmarks"]
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen criterion\n" ++ c) $ not $
......@@ -93,14 +93,13 @@ tests cabalPath =
, testCase "--disable-benchmarks does not freeze benchmark dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-benchmarks"] cabalPath
result <- cabal_freeze paths dir ["--disable-benchmarks"]
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen criterion\n" ++ c) $ not $
" criterion ==" `isInfixOf` (intercalate " " $ lines $ c)
]
removeCabalConfig :: IO ()
removeCabalConfig = do
removeFile (dir </> "cabal.config")
......
......@@ -13,16 +13,16 @@ import System.Directory (doesDirectoryExist)
import System.FilePath ((</>))
dir :: FilePath
dir = "PackageTests" </> "MultipleSource"
dir = packageTestsDirectory </> "MultipleSource"
tests :: FilePath -> [TF.Test]
tests cabalPath =
tests :: TestsPaths -> [TF.Test]
tests paths =
[ testCase "finds second source of multiple source" $ do
sandboxExists <- doesDirectoryExist $ dir </> ".cabal-sandbox"
when sandboxExists $
void $ cabal_sandbox dir ["delete"] cabalPath
assertSandboxSucceeded =<< cabal_sandbox dir ["init"] cabalPath
assertSandboxSucceeded =<< cabal_sandbox dir ["add-source", "p"] cabalPath
assertSandboxSucceeded =<< cabal_sandbox dir ["add-source", "q"] cabalPath
assertInstallSucceeded =<< cabal_install dir ["q"] cabalPath
void $ cabal_sandbox paths dir ["delete"]
assertSandboxSucceeded =<< cabal_sandbox paths dir ["init"]
assertSandboxSucceeded =<< cabal_sandbox paths dir ["add-source", "p"]
assertSandboxSucceeded =<< cabal_sandbox paths dir ["add-source", "q"]
assertInstallSucceeded =<< cabal_install paths dir ["q"]
]
......@@ -17,7 +17,11 @@
-- You can set the following VERBOSE environment variable to control
-- the verbosity of the output generated by this module.
module PackageTests.PackageTester
( Result(..)
( TestsPaths(..)
, Result(..)
, packageTestsDirectory
, packageTestsConfigFile
-- * Running cabal commands
, cabal_clean
......@@ -42,7 +46,7 @@ import Data.Maybe (fromMaybe)
import System.Directory (canonicalizePath, doesFileExist)
import System.Environment (getEnv)
import System.Exit (ExitCode(ExitSuccess))
import System.FilePath ((<.>))
import System.FilePath ( (<.>) )
import System.IO (hClose, hGetChar, hIsEOF)
import System.IO.Error (isDoesNotExistError)
import System.Process (runProcess, waitForProcess)
......@@ -66,6 +70,14 @@ data Success = Failure
| SandboxSuccess
deriving (Eq, Show)
data TestsPaths = TestsPaths
{ cabalPath :: FilePath -- ^ absolute path to cabal executable.
, ghcPkgPath :: FilePath -- ^ absolute path to ghc-pkg executable.
, configPath :: FilePath -- ^ absolute path of the default config file
-- to use for tests (tests are free to use
-- a different one).
}
data Result = Result
{ successful :: Bool
, success :: Success
......@@ -75,6 +87,15 @@ data Result = Result
nullResult :: Result
nullResult = Result True Failure ""
------------------------------------------------------------------------
-- * Config
packageTestsDirectory :: FilePath
packageTestsDirectory = "PackageTests"
packageTestsConfigFile :: FilePath
packageTestsConfigFile = "cabal-config"
------------------------------------------------------------------------
-- * Running cabal commands
......@@ -89,39 +110,42 @@ recordRun (cmd, exitCode, exeOutput) thisSucc res =
}
-- | Run the clean command and return its result.
cabal_clean :: FilePath -> [String] -> FilePath -> IO Result
cabal_clean dir args cabalPath = do
res <- cabal dir (["clean"] ++ args) cabalPath
cabal_clean :: TestsPaths -> FilePath -> [String] -> IO Result
cabal_clean paths dir args = do
res <- cabal paths dir (["clean"] ++ args)
return $ recordRun res CleanSuccess nullResult
-- | Run the exec command and return its result.
cabal_exec :: FilePath -> [String] -> FilePath -> IO Result
cabal_exec dir args cabalPath = do
res <- cabal dir (["exec"] ++ args) cabalPath
cabal_exec :: TestsPaths -> FilePath -> [String] -> IO Result
cabal_exec paths dir args = do
res <- cabal paths dir (["exec"] ++ args)
return $ recordRun res ExecSuccess nullResult
-- | Run the freeze command and return its result.
cabal_freeze :: FilePath -> [String] -> FilePath -> IO Result
cabal_freeze dir args cabalPath = do
res <- cabal dir (["freeze"] ++ args) cabalPath
cabal_freeze :: TestsPaths -> FilePath -> [String] -> IO Result
cabal_freeze paths dir args = do
res <- cabal paths dir (["freeze"] ++ args)
return $ recordRun res FreezeSuccess nullResult
-- | Run the install command and return its result.
cabal_install :: FilePath -> [String] -> FilePath -> IO Result
cabal_install dir args cabalPath = do
res <- cabal dir (["install"] ++ args) cabalPath
cabal_install :: TestsPaths -> FilePath -> [String] -> IO Result
cabal_install paths dir args = do
res <- cabal paths dir (["install"] ++ args)
return $ recordRun res InstallSuccess nullResult
-- | Run the sandbox command and return its result.
cabal_sandbox :: FilePath -> [String] -> FilePath -> IO Result
cabal_sandbox dir args cabalPath = do
res <- cabal dir (["sandbox"] ++ args) cabalPath
cabal_sandbox :: TestsPaths -> FilePath -> [String] -> IO Result
cabal_sandbox paths dir args = do
res <- cabal paths dir (["sandbox"] ++ args)
return $ recordRun res SandboxSuccess nullResult
-- | Returns the command that was issued, the return code, and the output text.
cabal :: FilePath -> [String] -> FilePath -> IO (String, ExitCode, String)
cabal dir cabalArgs cabalPath = do
run (Just dir) cabalPath cabalArgs
cabal :: TestsPaths -> FilePath -> [String] -> IO (String, ExitCode, String)
cabal paths dir cabalArgs = do
run (Just dir) (cabalPath paths) args
where
args = configFileArg : cabalArgs
configFileArg = "--config-file=" ++ configPath paths
-- | Returns the command that was issued, the return code, and the output text
run :: Maybe FilePath -> String -> [String] -> IO (String, ExitCode, String)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment