haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-20 19:21:57 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Still build docs when no test suites available

Browse Source
This commit is contained in:
Michael Snoyman 2012-11-29 15:57:41 +02:00
parent a0d0948dea
commit ecc9cebbd6
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Stackage/Test.hs
View File

@ -25,12 +25,12 @@ runTestSuites root ii = do
let testdir = "runtests" let testdir = "runtests"
rm_r testdir rm_r testdir
createDirectory testdir createDirectory testdir
allPass <- foldM (runTestSuite root testdir) True $ filter hasTestSuites $ Map.toList $ iiPackages ii allPass <- foldM (runTestSuite root testdir hasTestSuites) True $ Map.toList $ iiPackages ii
unless allPass $ error $ "There were failures, please see the logs in " ++ testdir unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
where where
PackageDB pdb = iiPackageDB ii PackageDB pdb = iiPackageDB ii
hasTestSuites (name, _) = maybe defaultHasTestSuites piHasTests $ Map.lookup name pdb hasTestSuites name = maybe defaultHasTestSuites piHasTests $ Map.lookup name pdb
-- | Separate for the PATH environment variable -- | Separate for the PATH environment variable
pathSep :: Char pathSep :: Char
@ -48,8 +48,13 @@ data TestException = TestException
deriving (Show, Typeable) deriving (Show, Typeable)
instance Exception TestException instance Exception TestException
runTestSuite :: FilePath -> FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool runTestSuite :: FilePath
runTestSuite root testdir prevPassed (packageName, (version, Maintainer maintainer)) = do -> FilePath
-> (PackageName -> Bool) -- ^ do we have any test suites?
-> Bool
-> (PackageName, (Version, Maintainer))
-> IO Bool
runTestSuite root testdir hasTestSuites prevPassed (packageName, (version, Maintainer maintainer)) = do
-- Set up a new environment that includes the sandboxed bin folder in PATH. -- Set up a new environment that includes the sandboxed bin folder in PATH.
env' <- getEnvironment env' <- getEnvironment
let menv = Just $ map (fixEnv $ binDir root) env' let menv = Just $ map (fixEnv $ binDir root) env'
@ -62,8 +67,9 @@ runTestSuite root testdir prevPassed (packageName, (version, Maintainer maintain
passed <- handle (\TestException -> return False) $ do passed <- handle (\TestException -> return False) $ do
getHandle WriteMode $ run "cabal" ["unpack", package] testdir getHandle WriteMode $ run "cabal" ["unpack", package] testdir
getHandle AppendMode $ run "cabal" (addCabalArgs root ["configure", "--enable-tests"]) dir getHandle AppendMode $ run "cabal" (addCabalArgs root ["configure", "--enable-tests"]) dir
getHandle AppendMode $ run "cabal" ["build"] dir when (hasTestSuites packageName) $ do
getHandle AppendMode $ run "cabal" ["test"] dir getHandle AppendMode $ run "cabal" ["build"] dir
getHandle AppendMode $ run "cabal" ["test"] dir
getHandle AppendMode $ run "cabal" ["haddock"] dir getHandle AppendMode $ run "cabal" ["haddock"] dir
return True return True
let expectedFailure = packageName `Set.member` expectedFailures let expectedFailure = packageName `Set.member` expectedFailures