Skip building test suites when they are not available

This commit is contained in:
Michael Snoyman 2012-11-26 14:44:33 +02:00
parent 6eb18c270c
commit 1ae93324d3
5 changed files with 27 additions and 12 deletions

View File

@ -29,6 +29,7 @@ getInstallInfo = do
{ iiCore = totalCore
, iiPackages = Map.map fst final
, iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp
, iiPackageDB = pdb
}
showDep :: (PackageName, (Version, [PackageName])) -> String

View File

@ -58,21 +58,24 @@ loadPackageDB core deps = do
| not $ withinRange v vrange -> return pdb
_ ->
case Tar.entryContent e of
Tar.NormalFile bs _ -> return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo
{ piVersion = v
, piDeps = parseDeps bs
}
Tar.NormalFile bs _ -> do
let (deps', hasTests) = parseDeps bs
return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo
{ piVersion = v
, piDeps = deps'
, piHasTests = hasTests
}
_ -> return pdb
parseDeps lbs =
case parsePackageDescription $ L8.unpack lbs of
ParseOk _ gpd -> mconcat
ParseOk _ gpd -> (mconcat
[ maybe mempty (go gpd) $ condLibrary gpd
, mconcat $ map (go gpd . snd) $ condExecutables gpd
, mconcat $ map (go gpd . snd) $ condTestSuites gpd
, mconcat $ map (go gpd . snd) $ condBenchmarks gpd
]
_ -> mempty
], not $ null $ condTestSuites gpd)
_ -> (mempty, defaultHasTestSuites)
where
go gpd tree
= Set.unions

View File

@ -16,16 +16,18 @@ import System.FilePath ((<.>), (</>))
import System.IO (IOMode (WriteMode, AppendMode),
withBinaryFile)
import System.Process (runProcess, waitForProcess)
import Distribution.Text
import Data.Maybe
runTestSuites :: InstallInfo -> IO ()
runTestSuites ii = do
let testdir = "runtests"
rm_r testdir
createDirectory testdir
allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii
allPass <- foldM (runTestSuite testdir) True $ filter hasTestSuites $ Map.toList $ iiPackages ii
unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
where
PackageDB pdb = iiPackageDB ii
hasTestSuites (name, _) = maybe defaultHasTestSuites piHasTests $ Map.lookup name pdb
-- | Separate for the PATH environment variable
pathSep :: Char

View File

@ -25,8 +25,9 @@ instance Monoid PackageDB where
| otherwise = pi2
data PackageInfo = PackageInfo
{ piVersion :: Version
, piDeps :: Set PackageName
{ piVersion :: Version
, piDeps :: Set PackageName
, piHasTests :: Bool
}
deriving (Show, Eq, Ord)
@ -46,4 +47,5 @@ data InstallInfo = InstallInfo
-- ^ This is intended to hold onto packages which might be automatically
-- provided in the global package database. In practice, this would be
-- Haskell Platform packages provided by distributions.
, iiPackageDB :: PackageDB
}

View File

@ -61,3 +61,10 @@ getPackageVersion e = do
Just (package, version)
where
fp = TarEntry.fromTarPathToPosixPath $ TarEntry.entryTarPath e
-- | If a package cannot be parsed or is not found, the default value for
-- whether it has a test suite. We default to @True@ since, worst case
-- scenario, this just means a little extra time trying to run a suite that's
-- not there. Defaulting to @False@ would result in silent failures.
defaultHasTestSuites :: Bool
defaultHasTestSuites = True