haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-03-11 11:16:34 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Status code returned on haddock/test failures

Browse Source
This commit is contained in:
Chris Done 2015-02-18 23:18:53 +01:00
parent 81e0dc2d98
commit c27df5e831
1 changed files with 20 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
Stackage/ShakeBuild.hs
View File

@ -56,6 +56,7 @@ data Env = Env
,envPB :: PerformBuild -- ^ Build perform settings. ,envPB :: PerformBuild -- ^ Build perform settings.
,envRegistered :: [PackageIdentifier] -- ^ Registered packages. ,envRegistered :: [PackageIdentifier] -- ^ Registered packages.
,envMsgLock :: MVar () -- ^ A lock for printing to the log. ,envMsgLock :: MVar () -- ^ A lock for printing to the log.
,envStatus :: TVar ExitCode
} }
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -76,6 +77,7 @@ performBuild pb' = do
} }
pkgs <- getRegisteredPackages (buildDatabase pb) pkgs <- getRegisteredPackages (buildDatabase pb)
msgLock <- newMVar () msgLock <- newMVar ()
status <- newTVarIO ExitSuccess
let !env = Env let !env = Env
{ envCur = cur { envCur = cur
, envShake = shakeDir , envShake = shakeDir
@ -84,11 +86,16 @@ performBuild pb' = do
, envPB = pb , envPB = pb
, envRegistered = pkgs , envRegistered = pkgs
, envMsgLock = msgLock , envMsgLock = msgLock
, envStatus = status
} }
checkBuildTools env checkBuildTools env
cleanOldPackages env cleanOldPackages env
printNewPackages env printNewPackages env
startShake num shakeDir (shakePlan env) startShake num shakeDir (shakePlan env)
st <- readTVarIO status
case st of
ExitSuccess -> return ()
_ -> throw st
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- The whole Shake plan -- The whole Shake plan
@ -377,7 +384,12 @@ packageTarget env@Env{..} name plan = do
pkgCabal verbosity = succeed . cabal env verbosity prefix logFile dir pkgCabal verbosity = succeed . cabal env verbosity prefix logFile dir
pkgCabal Normal ["build","--ghc-options=" <> pbGhcOptions envPB] pkgCabal Normal ["build","--ghc-options=" <> pbGhcOptions envPB]
when (pbEnableTests envPB) when (pbEnableTests envPB)
(succeed (cabal env Normal prefix logFile dir ["test"])) (do result <- cabal env Normal prefix logFile dir ["test"]
case result of
ExitFailure{} ->
do logLn env Normal (prefix <> "TEST SUITE FAILED")
failed env result
_ -> return ())
pkgCabal Verbose ["copy"] pkgCabal Verbose ["copy"]
liftIO (withMVar envRegLock liftIO (withMVar envRegLock
(const (pkgCabal Verbose ["register"]))) (const (pkgCabal Verbose ["register"])))
@ -468,7 +480,7 @@ generateHaddocks env@Env{..} logfile pdir name version expected = do
logLn env Normal (prefix <> "expected failure for haddock generation, but it succeeded!") logLn env Normal (prefix <> "expected failure for haddock generation, but it succeeded!")
(ExitFailure{},ExpectSuccess) -> (ExitFailure{},ExpectSuccess) ->
do logLn env Normal (prefix <> "expected success for haddock, but it failed!") do logLn env Normal (prefix <> "expected success for haddock, but it failed!")
throw exitCode -- FIXME: report it failed env exitCode
_ -> return () _ -> return ()
copy copy
where where
@ -529,6 +541,12 @@ cabal env verbosity prefix logfile cwd args = do
FP.readFile logfile >>= logLn env Normal FP.readFile logfile >>= logLn env Normal
return code return code
-- | A result failed.
failed :: MonadIO m => Env -> ExitCode -> m ()
failed env code = liftIO
(atomically
(writeTVar (envStatus env) code))
-- | The action must return a success code or an exception is thrown. -- | The action must return a success code or an exception is thrown.
succeed :: MonadIO m succeed :: MonadIO m
=> m ExitCode -> m () => m ExitCode -> m ()