Commit 41d89064 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #2868 from phadej/gh-2797-2

Migrate integration tests to shell based format, fixed travis
parents d430cbd5 25b18bf4
......@@ -117,13 +117,14 @@ extra-source-files:
tests/PackageTests/TestSuiteTests/ExeV10/Foo.hs
tests/PackageTests/TestSuiteTests/ExeV10/my.cabal
tests/PackageTests/TestSuiteTests/ExeV10/tests/test-Foo.hs
tests/PackageTests/TestSuiteTests/LibV09/LibV09.cabal
tests/PackageTests/TestSuiteTests/LibV09/Lib.hs
tests/PackageTests/TestSuiteTests/LibV09/LibV09.cabal
tests/PackageTests/TestSuiteTests/LibV09/tests/Deadlock.hs
tests/PackageTests/UniqueIPID/P1/M.hs
tests/PackageTests/UniqueIPID/P1/my.cabal
tests/PackageTests/UniqueIPID/P2/M.hs
tests/PackageTests/UniqueIPID/P2/my.cabal
tests/PackageTests/multInst/my.cabal
tests/Setup.hs
tests/Test/Distribution/Version.hs
tests/Test/Laws.hs
......@@ -173,6 +174,7 @@ library
Distribution.Compat.CreatePipe
Distribution.Compat.Environment
Distribution.Compat.Exception
Distribution.Compat.Internal.TempFile
Distribution.Compat.ReadP
Distribution.Compiler
Distribution.InstalledPackageInfo
......@@ -247,7 +249,6 @@ library
other-modules:
Distribution.Compat.Binary
Distribution.Compat.CopyFile
Distribution.Compat.TempFile
Distribution.GetOpt
Distribution.Lex
Distribution.Simple.GHC.Internal
......
......@@ -23,7 +23,7 @@ import System.IO.Error
( ioeSetLocation )
import System.Directory
( doesFileExist, renameFile, removeFile )
import Distribution.Compat.TempFile
import Distribution.Compat.Internal.TempFile
( openBinaryTempFile )
import System.FilePath
( takeDirectory )
......
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
module Distribution.Compat.TempFile (
module Distribution.Compat.Internal.TempFile (
openTempFile,
openBinaryTempFile,
openNewBinaryFile,
......
......@@ -8,7 +8,7 @@ module Distribution.Simple.Test.LibV09
import Distribution.Compat.CreatePipe ( createPipe )
import Distribution.Compat.Environment ( getEnvironment )
import Distribution.Compat.TempFile ( openTempFile )
import Distribution.Compat.Internal.TempFile ( openTempFile )
import Distribution.ModuleName ( ModuleName )
import qualified Distribution.PackageDescription as PD
import Distribution.Simple.Build.PathsModule ( pkgPathEnvVar )
......
......@@ -203,7 +203,7 @@ import System.Process
import Distribution.Compat.CopyFile
( copyFile, copyOrdinaryFile, copyExecutableFile
, setFileOrdinary, setFileExecutable, setDirOrdinary )
import Distribution.Compat.TempFile
import Distribution.Compat.Internal.TempFile
( openTempFile, createTempDirectory )
import Distribution.Compat.Exception
( tryIO, catchIO, catchExit )
......
......@@ -27,7 +27,35 @@ Extra-Source-Files:
README.md bash-completion/cabal bootstrap.sh changelog
-- Generated with '../Cabal/misc/gen-extra-source-files.sh | sort'
tests/PackageTests/Freeze/my.cabal
tests/IntegrationTests/exec/common.sh
tests/IntegrationTests/exec/should_run/Foo.hs
tests/IntegrationTests/exec/should_run/My.hs
tests/IntegrationTests/exec/should_run/adds_sandbox_bin_directory_to_path.sh
tests/IntegrationTests/exec/should_run/auto_configures_on_exec.sh
tests/IntegrationTests/exec/should_run/can_run_executables_installed_in_sandbox.sh
tests/IntegrationTests/exec/should_run/configures_cabal_to_use_sandbox.sh
tests/IntegrationTests/exec/should_run/configures_ghc_to_use_sandbox.sh
tests/IntegrationTests/exec/should_run/exit_with_failure_without_args.sh
tests/IntegrationTests/exec/should_run/my.cabal
tests/IntegrationTests/exec/should_run/runs_given_command.sh
tests/IntegrationTests/freeze/common.sh
tests/IntegrationTests/freeze/should_run/disable_benchmarks_freezes_bench_deps.sh
tests/IntegrationTests/freeze/should_run/disable_tests_freezes_test_deps.sh
tests/IntegrationTests/freeze/should_run/does_not_freeze_nondeps.sh
tests/IntegrationTests/freeze/should_run/does_not_freeze_self.sh
tests/IntegrationTests/freeze/should_run/dry_run_does_not_create_config.sh
tests/IntegrationTests/freeze/should_run/enable_benchmarks_freezes_bench_deps.sh
tests/IntegrationTests/freeze/should_run/enable_tests_freezes_test_deps.sh
tests/IntegrationTests/freeze/should_run/freezes_direct_dependencies.sh
tests/IntegrationTests/freeze/should_run/freezes_transitive_dependencies.sh
tests/IntegrationTests/freeze/should_run/my.cabal
tests/IntegrationTests/freeze/should_run/runs_without_error.sh
tests/IntegrationTests/multiple-source/common.sh
tests/IntegrationTests/multiple-source/should_run/finds_second_source_of_multiple_source.sh
tests/IntegrationTests/multiple-source/should_run/p/Setup.hs
tests/IntegrationTests/multiple-source/should_run/p/p.cabal
tests/IntegrationTests/multiple-source/should_run/q/Setup.hs
tests/IntegrationTests/multiple-source/should_run/q/q.cabal
source-repository head
type: git
......@@ -229,29 +257,20 @@ Test-Suite unit-tests
ghc-options: -threaded
default-language: Haskell2010
-- Large, system tests that build packages.
test-suite package-tests
test-suite integration-tests
type: exitcode-stdio-1.0
hs-source-dirs: tests
main-is: PackageTests.hs
other-modules:
PackageTests.Exec.Check
PackageTests.Freeze.Check
PackageTests.MultipleSource.Check
PackageTests.PackageTester
main-is: IntegrationTests.hs
build-depends:
Cabal,
QuickCheck >= 2.1.0.1 && < 2.9,
async,
base,
bytestring,
directory,
extensible-exceptions,
filepath,
process,
regex-posix,
tasty,
tasty-hunit,
tasty-quickcheck
tasty-hunit
if os(windows)
build-depends: Win32 >= 2 && < 3
......
-- | Groups black-box tests of cabal-install and configures them to test
-- the correct binary.
--
-- This file should do nothing but import tests from other modules and run
-- them with the path to the correct cabal-install binary.
module Main
where
-- Modules from Cabal.
import Distribution.Compat.CreatePipe (createPipe)
import Distribution.Compat.Environment (setEnv)
import Distribution.Compat.Internal.TempFile (createTempDirectory)
import Distribution.Simple.Configure (findDistPrefOrDefault)
import Distribution.Simple.Program.Builtin (ghcPkgProgram)
import Distribution.Simple.Program.Db
(defaultProgramDb, requireProgram, setProgramSearchPath)
import Distribution.Simple.Program.Find
(ProgramSearchPathEntry(ProgramSearchPathDir), defaultProgramSearchPath)
import Distribution.Simple.Program.Types
( Program(..), simpleProgram, programPath)
import Distribution.Simple.Setup ( Flag(..) )
import Distribution.Simple.Utils ( findProgramVersion, copyDirectoryRecursive )
import Distribution.Verbosity (normal)
-- Third party modules.
import Control.Concurrent.Async (withAsync, wait)
import Control.Exception (bracket)
import Data.Maybe (fromMaybe)
import System.Directory
( canonicalizePath
, findExecutable
, getDirectoryContents
, getTemporaryDirectory
, doesDirectoryExist
, removeDirectoryRecursive
, doesFileExist )
import System.FilePath ((</>), replaceExtension)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (testCase, Assertion, assertFailure)
import Control.Monad ( filterM, forM, when )
import Data.List (isPrefixOf, isSuffixOf, sort)
import Data.IORef (newIORef, writeIORef, readIORef)
import System.Exit (ExitCode(..))
import System.IO (withBinaryFile, IOMode(ReadMode))
import System.Process (runProcess, waitForProcess)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8
import Data.ByteString (ByteString)
-- | Test case.
data TestCase = TestCase
{ tcName :: String -- ^ Name of the shell script
, tcBaseDirectory :: FilePath
, tcCategory :: String
, tcShouldX :: String
, tcStdOutPath :: Maybe FilePath -- ^ File path of "golden standard output"
, tcStdErrPath :: Maybe FilePath -- ^ File path of "golden standard error"
}
-- | Test result.
data TestResult = TestResult
{ trExitCode :: ExitCode
, trStdOut :: ByteString
, trStdErr :: ByteString
, trWorkingDirectory :: FilePath
}
-- | Cabal executable
cabalProgram :: Program
cabalProgram = (simpleProgram "cabal") {
programFindVersion = findProgramVersion "--numeric-version" id
}
-- | Convert test result to string.
testResultToString :: TestResult -> String
testResultToString testResult =
exitStatus ++ "\n" ++ workingDirectory ++ "\n\n" ++ stdOut ++ "\n\n" ++ stdErr
where
exitStatus = "Exit status: " ++ show (trExitCode testResult)
workingDirectory = "Working directory: " ++ (trWorkingDirectory testResult)
stdOut = "<stdout> was:\n" ++ C8.unpack (trStdOut testResult)
stdErr = "<stderr> was:\n" ++ C8.unpack (trStdErr testResult)
-- | Returns the command that was issued, the return code, and the output text
run :: FilePath -> String -> [String] -> IO TestResult
run cwd path args = do
-- path is relative to the current directory; canonicalizePath makes it
-- absolute, so that runProcess will find it even when changing directory.
path' <- canonicalizePath path
(pid, hReadStdOut, hReadStdErr) <- do
-- Create pipes for StdOut and StdErr
(hReadStdOut, hWriteStdOut) <- createPipe
(hReadStdErr, hWriteStdErr) <- createPipe
-- Run the process
pid <- runProcess path' args (Just cwd) Nothing Nothing (Just hWriteStdOut) (Just hWriteStdErr)
-- Return the pid and read ends of the pipes
return (pid, hReadStdOut, hReadStdErr)
-- Read subprocess output using asynchronous threads; we need to
-- do this aynchronously to avoid deadlocks due to buffers filling
-- up.
withAsync (B.hGetContents hReadStdOut) $ \stdOutAsync -> do
withAsync (B.hGetContents hReadStdErr) $ \stdErrAsync -> do
-- Wait for the subprocess to terminate
exitcode <- waitForProcess pid
-- We can now be sure that no further output is going to arrive,
-- so we wait for the results of the asynchronous reads.
stdOut <- wait stdOutAsync
stdErr <- wait stdErrAsync
-- Done
return $ TestResult exitcode stdOut stdErr cwd
-- | Get a list of all names in a directory, excluding all hidden or
-- system files/directories such as '.', '..' or any files/directories
-- starting with a '.'.
listDirectory :: FilePath -> IO [String]
listDirectory directory = do
fmap (filter notHidden) $ getDirectoryContents directory
where
notHidden = not . isHidden
isHidden name = "." `isPrefixOf` name
-- | List a directory as per 'listDirectory', but return an empty list
-- in case the directory does not exist.
listDirectoryLax :: FilePath -> IO [String]
listDirectoryLax directory = do
d <- doesDirectoryExist directory
if d then
listDirectory directory
else
return [ ]
pathIfExists :: FilePath -> IO (Maybe FilePath)
pathIfExists p = do
e <- doesFileExist p
if e then
return $ Just p
else
return Nothing
fileMatchesString :: FilePath -> ByteString -> IO Bool
fileMatchesString p s = do
withBinaryFile p ReadMode $ \h -> do
s' <- B.hGetContents h -- Strict
return $ normalizeLinebreaks s' == normalizeLinebreaks s
where
-- This is a bit of a hack, but since we're comparing
-- *text* output, we should be OK.
normalizeLinebreaks = B.filter (not . ((==) 13))
mustMatch :: TestResult -> String -> ByteString -> Maybe FilePath -> Assertion
mustMatch _ _ _ Nothing = return ()
mustMatch testResult handleName s (Just p) = do
m <- fileMatchesString p s
if not m then
assertFailure $ "<" ++ handleName ++ "> did not match file '" ++ p ++ "'.\n" ++ testResultToString testResult
else
return ()
discoverTestCategories :: FilePath -> IO [String]
discoverTestCategories directory = do
names <- listDirectory directory
fmap sort $ filterM (\name -> doesDirectoryExist $ directory </> name) names
discoverTestCases :: FilePath -> String -> String -> IO [TestCase]
discoverTestCases baseDirectory category shouldX = do
-- Find the names of the shell scripts
names <- fmap (filter isTestCase) $ listDirectoryLax directory
-- Fill in TestCase for each script
forM (sort names) $ \name -> do
stdOutPath <- pathIfExists $ directory </> name `replaceExtension` ".out"
stdErrPath <- pathIfExists $ directory </> name `replaceExtension` ".err"
return $ TestCase { tcName = name
, tcBaseDirectory = baseDirectory
, tcCategory = category
, tcShouldX = shouldX
, tcStdOutPath = stdOutPath
, tcStdErrPath = stdErrPath
}
where
directory = baseDirectory </> category </> shouldX
isTestCase name = ".sh" `isSuffixOf` name
createTestCases :: [TestCase] -> (TestCase -> Assertion) -> IO [TestTree]
createTestCases testCases mk =
return $ (flip map) testCases $ \tc -> testCase (tcName tc ++ suffix tc) $ mk tc
where
suffix tc = case (tcStdOutPath tc, tcStdErrPath tc) of
(Nothing, Nothing) -> " (ignoring stdout+stderr)"
(Just _ , Nothing) -> " (ignoring stderr)"
(Nothing, Just _ ) -> " (ignoring stdout)"
(Just _ , Just _ ) -> ""
runTestCase :: (TestResult -> Assertion) -> TestCase -> IO ()
runTestCase assertResult tc = do
doRemove <- newIORef False
bracket createWorkDirectory (removeWorkDirectory doRemove) $ \workDirectory -> do
-- Run
let scriptDirectory = workDirectory </> tcShouldX tc
sh <- fmap (fromMaybe $ error "Cannot find 'sh' executable") $ findExecutable "sh"
testResult <- run scriptDirectory sh [ "-e", tcName tc]
-- Assert that we got what we expected
assertResult testResult
mustMatch testResult "stdout" (trStdOut testResult) (tcStdOutPath tc)
mustMatch testResult "stderr" (trStdErr testResult) (tcStdErrPath tc)
-- Only remove working directory if test succeeded
writeIORef doRemove True
where
createWorkDirectory = do
-- Create the temporary directory
tempDirectory <- getTemporaryDirectory
workDirectory <- createTempDirectory tempDirectory "cabal-install-test"
-- Copy all the files from the category into the working directory.
copyDirectoryRecursive normal
(tcBaseDirectory tc </> tcCategory tc)
workDirectory
-- Done
return workDirectory
removeWorkDirectory doRemove workDirectory = do
remove <- readIORef doRemove
when remove $ removeDirectoryRecursive workDirectory
makeShouldXTests :: FilePath -> String -> String -> (TestResult -> Assertion) -> IO [TestTree]
makeShouldXTests baseDirectory category shouldX assertResult = do
testCases <- discoverTestCases baseDirectory category shouldX
createTestCases testCases $ \tc ->
runTestCase assertResult tc
makeShouldRunTests :: FilePath -> String -> IO [TestTree]
makeShouldRunTests baseDirectory category = do
makeShouldXTests baseDirectory category "should_run" $ \testResult -> do
case trExitCode testResult of
ExitSuccess ->
return () -- We're good
ExitFailure _ ->
assertFailure $ "Unexpected exit status.\n\n" ++ testResultToString testResult
makeShouldFailTests :: FilePath -> String -> IO [TestTree]
makeShouldFailTests baseDirectory category = do
makeShouldXTests baseDirectory category "should_fail" $ \testResult -> do
case trExitCode testResult of
ExitSuccess ->
assertFailure $ "Unexpected exit status.\n\n" ++ testResultToString testResult
ExitFailure _ ->
return () -- We're good
discoverCategoryTests :: FilePath -> String -> IO [TestTree]
discoverCategoryTests baseDirectory category = do
srTests <- makeShouldRunTests baseDirectory category
sfTests <- makeShouldFailTests baseDirectory category
return [ testGroup "should_run" srTests
, testGroup "should_fail" sfTests
]
main :: IO ()
main = do
-- Find executables and build directories, etc.
distPref <- findDistPrefOrDefault NoFlag
buildDir <- canonicalizePath (distPref </> "build/cabal")
let programSearchPath = ProgramSearchPathDir buildDir : defaultProgramSearchPath
(cabal, _) <- requireProgram normal cabalProgram (setProgramSearchPath programSearchPath defaultProgramDb)
(ghcPkg, _) <- requireProgram normal ghcPkgProgram defaultProgramDb
baseDirectory <- canonicalizePath $ "tests" </> "IntegrationTests"
-- Set up environment variables for test scripts
setEnv "GHC_PKG" $ programPath ghcPkg
setEnv "CABAL" $ programPath cabal
setEnv "CABAL_ARGS" $ "--config-file=config-file"
-- Discover all the test caregories
categories <- discoverTestCategories baseDirectory
-- Discover tests in each category
tests <- forM categories $ \category -> do
categoryTests <- discoverCategoryTests baseDirectory category
return (category, categoryTests)
-- Map into a test tree
let testTree = map (\(category, categoryTests) -> testGroup category categoryTests) tests
-- Run the tests
defaultMain $ testGroup "Integration Tests" $ testTree
# Helper to run Cabal
cabal() {
$CABAL $CABAL_ARGS "$@"
}
die() {
echo "die: $@"
exit 1
}
. ../common.sh
cabal sandbox delete > /dev/null
cabal exec my-executable && die "Unexpectedly found executable"
cabal sandbox init > /dev/null
cabal install > /dev/null
# Execute indirectly via bash to ensure that we go through $PATH
cabal exec sh -- -c my-executable || die "Did not find executable"
Config file path source is commandline option.
Config file config-file not found.
Writing default configuration to config-file
find_me_in_output
. ../common.sh
cabal sandbox delete > /dev/null
cabal exec my-executable && die "Unexpectedly found executable"
cabal sandbox init > /dev/null
cabal install > /dev/null
cabal exec my-executable || die "Did not find executable"
. ../common.sh
cabal sandbox delete > /dev/null
cabal exec my-executable && die "Unexpectedly found executable"
cabal sandbox init > /dev/null
cabal install > /dev/null
# The library should not be available outside the sandbox
$GHC_PKG list | grep -v "my-0.1"
# When run inside 'cabal-exec' the 'sandbox hc-pkg list' sub-command
# should find the library.
cabal exec sh -- -c 'cd subdir && $CABAL sandbox hc-pkg list' | grep "my-0.1"
. ../common.sh
cabal sandbox delete > /dev/null
cabal exec my-executable && die "Unexpectedly found executable"
cabal sandbox init > /dev/null
cabal install > /dev/null
# The library should not be available outside the sandbox
$GHC_PKG list | grep -v "my-0.1"
# Execute ghc-pkg inside the sandbox; it should find my-0.1
cabal exec ghc-pkg list | grep "my-0.1"
. ../common.sh
# We should probably be using a .err file and should_fail,
# but this fails on windows due to the ".exe" on the cabal
# executable in the output.
cabal exec 2>&1 > /dev/null | grep "Please specify an executable to run"
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