Commit 40846f06 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add new integration tests, initially covering build exceptions

These integration tests, unlike the existing ones, don't call cabal as
an external processes. Instead they use the cabal code directly. This
makes it possible to conveniently test catching exceptions.

Add a couple tests for exceptions in finding projects. There should be a
lot more for the various phases of planning.

Also add a couple tests for exceptions in the configure and build
phases. These test the previous patch that improves the exception
handling so that failures are added into the residual plan rather than
just propagating immediately.
parent 30d6d9f8
......@@ -121,6 +121,12 @@ Extra-Source-Files:
tests/IntegrationTests/user-config/runs_without_error.sh
tests/IntegrationTests/user-config/uses_CABAL_CONFIG.out
tests/IntegrationTests/user-config/uses_CABAL_CONFIG.sh
tests/IntegrationTests2.hs
tests/IntegrationTests2/exception/build/Main.hs
tests/IntegrationTests2/exception/build/a.cabal
tests/IntegrationTests2/exception/configure/a.cabal
tests/IntegrationTests2/exception/no-pkg/empty.in
tests/IntegrationTests2/exception/no-pkg2/cabal.project
-- END gen-extra-source-files
source-repository head
......@@ -466,6 +472,7 @@ Test-Suite solver-quickcheck
default-language: Haskell2010
-- Integration tests that call the cabal executable externally
test-suite integration-tests
type: exitcode-stdio-1.0
hs-source-dirs: tests
......@@ -493,6 +500,62 @@ test-suite integration-tests
ghc-options: -Wall
default-language: Haskell2010
-- Integration tests that use the cabal-install code directly
-- but still build whole projects
test-suite integration-tests2
type: exitcode-stdio-1.0
main-is: IntegrationTests2.hs
hs-source-dirs: tests, .
ghc-options: -Wall -fwarn-tabs
other-modules:
build-depends:
async,
array,
base,
base16-bytestring,
binary,
bytestring,
Cabal,
containers,
cryptohash-sha256,
directory,
filepath,
hackage-security,
hashable,
HTTP,
mtl,
network,
network-uri,
pretty,
process,
random,
stm,
tar,
time,
zlib,
tasty,
tasty-hunit
if flag(old-bytestring)
build-depends: bytestring-builder
if flag(old-directory)
build-depends: old-time
if impl(ghc < 7.6)
build-depends: ghc-prim >= 0.2 && < 0.3
if os(windows)
build-depends: Win32
else
build-depends: unix
if arch(arm)
cc-options: -DCABAL_NO_THREADED
else
ghc-options: -threaded
default-language: Haskell2010
custom-setup
setup-depends: Cabal >= 1.25,
base,
......
{-# LANGUAGE CPP #-}
module Main where
import Distribution.Client.DistDirLayout
import Distribution.Client.ProjectConfig
import Distribution.Client.Config (defaultCabalDir)
import Distribution.Client.ProjectPlanning
import Distribution.Client.ProjectBuilding
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.Types (GenericReadyPackage(..), installedPackageId)
import Distribution.Package hiding (installedPackageId)
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.Version
import Distribution.Verbosity
import Distribution.Text
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
import qualified Data.Map as Map
import Control.Monad
import Control.Exception
import System.FilePath
import System.Directory
import Test.Tasty
import Test.Tasty.HUnit
main :: IO ()
main = defaultMain (testGroup "Integration tests (internal)" tests)
tests :: [TestTree]
tests =
--TODO: tests for:
-- * normal success
-- * dry-run tests with changes
[ testGroup "Exceptions during discovey and planning" $
[ testCase "no package" testExceptionInFindingPackage
, testCase "no package2" testExceptionInFindingPackage2
]
, testGroup "Exceptions during building (local inplace)" $
[ testCase "configure" testExceptionInConfigureStep
, testCase "build" testExceptionInBuildStep
-- , testCase "register" testExceptionInRegisterStep
]
--TODO: need to repeat for packages for the store
]
testExceptionInFindingPackage :: Assertion
testExceptionInFindingPackage = do
BadPackageLocations locs <- expectException "BadPackageLocations" $
void $ planProject testdir config
case locs of
[BadLocGlobEmptyMatch "./*.cabal"] -> return ()
_ -> assertFailure "expected BadLocGlobEmptyMatch"
cleanProject testdir
where
testdir = "exception/no-pkg"
config = mempty
testExceptionInFindingPackage2 :: Assertion
testExceptionInFindingPackage2 = do
BadPackageLocations locs <- expectException "BadPackageLocations" $
void $ planProject testdir config
case locs of
[BadLocGlobBadMatches "./" [BadLocDirNoCabalFile "."]] -> return ()
_ -> assertFailure $ "expected BadLocGlobBadMatches, got " ++ show locs
cleanProject testdir
where
testdir = "exception/no-pkg2"
config = mempty
testExceptionInConfigureStep :: Assertion
testExceptionInConfigureStep = do
plan <- planProject testdir config
plan' <- executePlan plan
(_pkga1, failure) <- expectPackageFailed plan' pkgidA1
case failure of
ConfigureFailed _str -> return ()
_ -> assertFailure $ "expected ConfigureFailed, got " ++ show failure
cleanProject testdir
where
testdir = "exception/configure"
config = mempty
pkgidA1 = PackageIdentifier (PackageName "a") (Version [1] [])
testExceptionInBuildStep :: Assertion
testExceptionInBuildStep = do
plan <- planProject testdir config
plan' <- executePlan plan
(_pkga1, failure) <- expectPackageFailed plan' pkgidA1
case failure of
BuildFailed _str -> return ()
_ -> assertFailure $ "expected BuildFailed, got " ++ show failure
where
testdir = "exception/build"
config = mempty
pkgidA1 = PackageIdentifier (PackageName "a") (Version [1] [])
---------------------------------
-- Test utils to plan and build
--
planProject :: FilePath -> ProjectConfig -> IO PlanDetails
planProject testdir cliConfig = do
cabalDir <- defaultCabalDir
let cabalDirLayout = defaultCabalDirLayout cabalDir
projectRootDir <- canonicalizePath ("tests" </> "IntegrationTests2"
</> testdir)
let distDirLayout = defaultDistDirLayout projectRootDir
-- Clear state between test runs. The state remains if the previous run
-- ended in an exception (as we leave the files to help with debugging).
cleanProject testdir
(elaboratedPlan, elaboratedShared, projectConfig) <-
rebuildInstallPlan verbosity
projectRootDir distDirLayout cabalDirLayout
cliConfig
let targets =
Map.fromList
[ (installedPackageId pkg, [BuildDefaultComponents])
| InstallPlan.Configured pkg <- InstallPlan.toList elaboratedPlan
, pkgBuildStyle pkg == BuildInplaceOnly ]
elaboratedPlan' = pruneInstallPlanToTargets targets elaboratedPlan
(elaboratedPlan'', pkgsBuildStatus) <-
rebuildTargetsDryRun distDirLayout
elaboratedPlan'
let buildSettings = resolveBuildTimeSettings
verbosity cabalDirLayout
(projectConfigShared projectConfig)
(projectConfigBuildOnly projectConfig)
(projectConfigBuildOnly cliConfig)
return (distDirLayout,
elaboratedPlan'',
elaboratedShared,
pkgsBuildStatus,
buildSettings)
type PlanDetails = (DistDirLayout,
ElaboratedInstallPlan,
ElaboratedSharedConfig,
BuildStatusMap,
BuildTimeSettings)
executePlan :: PlanDetails -> IO ElaboratedInstallPlan
executePlan (distDirLayout,
elaboratedPlan,
elaboratedShared,
pkgsBuildStatus,
buildSettings) =
rebuildTargets verbosity
distDirLayout
elaboratedPlan
elaboratedShared
pkgsBuildStatus
-- Avoid trying to use act-as-setup mode:
buildSettings { buildSettingNumJobs = 1 }
cleanProject :: FilePath -> IO ()
cleanProject testdir = do
alreadyExists <- doesDirectoryExist distDir
when alreadyExists $ removeDirectoryRecursive distDir
where
projectRootDir = "tests" </> "IntegrationTests2" </> testdir
distDirLayout = defaultDistDirLayout projectRootDir
distDir = distDirectory distDirLayout
verbosity :: Verbosity
verbosity = minBound --normal --verbose --maxBound --minBound
---------------------------------------
-- HUint style utils for this context
--
expectException :: Exception e => String -> IO a -> IO e
expectException expected action = do
res <- try action
case res of
Left e -> return e
Right _ -> throwIO $ HUnitFailure $ "expected an exception " ++ expected
expectPackagePreExisting :: ElaboratedInstallPlan -> PackageId
-> IO InstalledPackageInfo
expectPackagePreExisting plan pkgid = do
planpkg <- expectPlanPackage plan pkgid
case planpkg of
InstallPlan.PreExisting pkg
-> return pkg
_ -> unexpectedPackageState "PreExisting" planpkg
expectPackageConfigured :: ElaboratedInstallPlan -> PackageId
-> IO ElaboratedConfiguredPackage
expectPackageConfigured plan pkgid = do
planpkg <- expectPlanPackage plan pkgid
case planpkg of
InstallPlan.Configured pkg
-> return pkg
_ -> unexpectedPackageState "Configured" planpkg
expectPackageInstalled :: ElaboratedInstallPlan -> PackageId
-> IO (ElaboratedConfiguredPackage,
Maybe InstalledPackageInfo,
BuildSuccess)
expectPackageInstalled plan pkgid = do
planpkg <- expectPlanPackage plan pkgid
case planpkg of
InstallPlan.Installed (ReadyPackage pkg) mipkg result
-> return (pkg, mipkg, result)
_ -> unexpectedPackageState "Installed" planpkg
expectPackageFailed :: ElaboratedInstallPlan -> PackageId
-> IO (ElaboratedConfiguredPackage,
BuildFailure)
expectPackageFailed plan pkgid = do
planpkg <- expectPlanPackage plan pkgid
case planpkg of
InstallPlan.Failed pkg failure
-> return (pkg, failure)
_ -> unexpectedPackageState "Failed" planpkg
unexpectedPackageState :: String -> ElaboratedPlanPackage -> IO a
unexpectedPackageState expected planpkg =
throwIO $ HUnitFailure $
"expected to find " ++ display (packageId planpkg) ++ " in the "
++ expected ++ " state, but it is actually in the " ++ actual ++ "state."
where
actual = case planpkg of
InstallPlan.PreExisting{} -> "PreExisting"
InstallPlan.Configured{} -> "Configured"
InstallPlan.Processing{} -> "Processing"
InstallPlan.Installed{} -> "Installed"
InstallPlan.Failed{} -> "Failed"
expectPlanPackage :: ElaboratedInstallPlan -> PackageId
-> IO ElaboratedPlanPackage
expectPlanPackage plan pkgid =
case [ pkg
| pkg <- InstallPlan.toList plan
, packageId pkg == pkgid ] of
[pkg] -> return pkg
[] -> throwIO $ HUnitFailure $
"expected to find " ++ display pkgid
++ " in the install plan but it's not there"
_ -> throwIO $ HUnitFailure $
"expected to find only one instance of " ++ display pkgid
++ " in the install plan but there's several"
name: a
version: 1
build-type: Simple
cabal-version: >= 1.2
executable a
main-is: Main.hs
build-depends: haskell2010
this is just here to ensure the source control creates the dir
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