Commit 96f806ae authored by Lennart Spitzner's avatar Lennart Spitzner
Browse files

cabal-install/tests: Clean up relative path mess

- add struct PackageTests.PackageTester.TestsPaths
- contains absolute paths for cabal, ghc, cabal-config
- refactor to consequently use this as input for all tests
parent fe36cc2b
......@@ -26,19 +26,24 @@ 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.PackageTester ( packageTestsDirectory )
import qualified PackageTests.Exec.Check
import qualified PackageTests.Freeze.Check
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
......@@ -52,14 +57,20 @@ 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 = PackageTests.PackageTester.packageTestsDirectory </> "cabal-config"
let confFile = packageTestsDirectory </> "cabal-config"
removeConf = do
b <- doesFileExist confFile
when b $ removeFile confFile
......@@ -68,7 +79,7 @@ main = do
removeConf -- assert that there is no existing config file
-- (we want deterministic testing with the default
-- config values)
defaultMain $ tests cabalPath ghcPkgPath
defaultMain $ tests testsPaths
runTests `E.finally` do
-- remove the default config file that got created by the tests
removeConf
......
......@@ -18,17 +18,14 @@ import System.Directory (getDirectoryContents)
dir :: FilePath
dir = packageTestsDirectory </> "Exec"
configPath :: FilePath
configPath = ".." </> packageTestsConfigFile
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 configPath
result <- cabal_exec paths dir []
assertExecFailed result
, testCase "prints error message if given no argument" $ do
result <- cabal_exec dir [] cabalPath configPath
result <- cabal_exec paths dir []
assertExecFailed result
let output = outputText result
expected = "specify an executable to run"
......@@ -38,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 configPath
result <- cabal_exec paths dir ["echo", "this", "string"]
assertExecSucceeded result
let output = outputText result
expected = "this string"
......@@ -52,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 configPath
result <- cabal_exec paths dir ["my-executable"]
assertExecSucceeded result
let output = outputText result
expected = "This is my-executable"
......@@ -65,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 configPath
result <- cabal_exec paths dir ["bash", "--", "-c", "my-executable"]
assertExecSucceeded result
let output = outputText result
expected = "This is my-executable"
......@@ -80,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 configPath
result <- cabal_exec paths dir ["ghc-pkg", "list"]
assertExecSucceeded result
let output = outputText result
errMsg = "my library should have been found"
......@@ -97,24 +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 configPath
assertCleanSucceeded =<< cabal_clean paths dir []
when sandboxExists $ do
assertSandboxSucceeded =<< cabal_sandbox dir ["delete"] cabalPath configPath
assertSandboxSucceeded =<< cabal_sandbox paths dir ["delete"]
assertPackageInstall :: FilePath -> IO ()
assertPackageInstall cabalPath = do
assertSandboxSucceeded =<< cabal_sandbox dir ["init"] cabalPath configPath
assertInstallSucceeded =<< cabal_install dir [] cabalPath configPath
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 configPath
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 " ++
......@@ -125,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)
......@@ -19,19 +19,16 @@ import System.IO.Error (isDoesNotExistError)
dir :: FilePath
dir = packageTestsDirectory </> "Freeze"
configPath :: FilePath
configPath = ".." </> packageTestsConfigFile
tests :: FilePath -> [TF.Test]
tests cabalPath =
tests :: TestsPaths -> [TF.Test]
tests paths =
[ testCase "runs without error" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath configPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
, testCase "freezes direct dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath configPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen base\n" ++ c) $
......@@ -39,7 +36,7 @@ tests cabalPath =
, testCase "freezes transitory dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath configPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen ghc-prim\n" ++ c) $
......@@ -49,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 configPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen exceptions\n" ++ c) $ not $
......@@ -57,7 +54,7 @@ tests cabalPath =
, testCase "does not include a constraint for the package being frozen" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath configPath
result <- cabal_freeze paths dir []
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen self\n" ++ c) $ not $
......@@ -65,14 +62,14 @@ tests cabalPath =
, testCase "--dry-run does not modify the cabal.config file" $ do
removeCabalConfig
result <- cabal_freeze dir ["--dry-run"] cabalPath configPath
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 configPath
result <- cabal_freeze paths dir ["--enable-tests"]
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen test-framework\n" ++ c) $
......@@ -80,7 +77,7 @@ tests cabalPath =
, testCase "--disable-tests does not freeze test dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-tests"] cabalPath configPath
result <- cabal_freeze paths dir ["--disable-tests"]
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen test-framework\n" ++ c) $ not $
......@@ -88,7 +85,7 @@ tests cabalPath =
, testCase "--enable-benchmarks freezes benchmark dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-benchmarks"] cabalPath configPath
result <- cabal_freeze paths dir ["--disable-benchmarks"]
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen criterion\n" ++ c) $ not $
......@@ -96,7 +93,7 @@ tests cabalPath =
, testCase "--disable-benchmarks does not freeze benchmark dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-benchmarks"] cabalPath configPath
result <- cabal_freeze paths dir ["--disable-benchmarks"]
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen criterion\n" ++ c) $ not $
......
......@@ -15,18 +15,14 @@ import System.FilePath ((</>))
dir :: FilePath
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"
let execute cmd params = cmd dir
params
cabalPath
(".." </> packageTestsConfigFile)
when sandboxExists $
void $ execute cabal_sandbox ["delete"]
assertSandboxSucceeded =<< execute cabal_sandbox ["init"]
assertSandboxSucceeded =<< execute cabal_sandbox ["add-source", "p"]
assertSandboxSucceeded =<< execute cabal_sandbox ["add-source", "q"]
assertInstallSucceeded =<< execute cabal_install ["q"]
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,8 @@
-- 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
......@@ -69,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
......@@ -101,46 +110,42 @@ recordRun (cmd, exitCode, exeOutput) thisSucc res =
}
-- | Run the clean command and return its result.
cabal_clean :: FilePath -> [String] -> FilePath -> FilePath -> IO Result
cabal_clean dir args cabalPath configPath = do
res <- cabal dir (["clean"] ++ args) cabalPath configPath
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 -> FilePath -> IO Result
cabal_exec dir args cabalPath configPath = do
res <- cabal dir (["exec"] ++ args) cabalPath configPath
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 -> FilePath -> IO Result
cabal_freeze dir args cabalPath configPath = do
res <- cabal dir (["freeze"] ++ args) cabalPath configPath
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 -> FilePath -> IO Result
cabal_install dir args cabalPath configPath = do
res <- cabal dir (["install"] ++ args) cabalPath configPath
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 -> FilePath -> IO Result
cabal_sandbox dir args cabalPath configPath = do
res <- cabal dir (["sandbox"] ++ args) cabalPath configPath
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
-> FilePath
-> IO (String, ExitCode, String)
cabal dir cabalArgs cabalPath configPath = do
run (Just dir) cabalPath args
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
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