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

Cleaner test running

Browse Source
This commit is contained in:
Michael Snoyman 2012-11-29 13:35:17 +02:00
parent d7ccf7406d
commit fd62aee254
1 changed files with 19 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
Stackage/Test.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Stackage.Test
( runTestSuites
) where
@ -16,6 +17,8 @@ import System.FilePath ((<.>), (</>))
import System.IO (IOMode (WriteMode, AppendMode),
withBinaryFile)
import System.Process (runProcess, waitForProcess)
import Control.Exception (handle, Exception, throwIO)
import Data.Typeable (Typeable)
runTestSuites :: InstallInfo -> IO ()
runTestSuites ii = do
@ -41,6 +44,10 @@ fixEnv :: FilePath -> (String, String) -> (String, String)
fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
fixEnv _ x = x
data TestException = TestException
deriving (Show, Typeable)
instance Exception TestException
runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool
runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do
-- Set up a new environment that includes the cabal-dev/bin folder in PATH.
@ -48,30 +55,18 @@ runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer))
bin <- canonicalizePath "cabal-dev/bin"
let menv = Just $ map (fixEnv bin) env'
passed <- do
ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) menv Nothing (Just handle) (Just handle)
ec1 <- waitForProcess ph1
if (ec1 /= ExitSuccess)
then return False
else do
ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) menv Nothing (Just handle) (Just handle)
ec2 <- waitForProcess ph2
if (ec2 /= ExitSuccess)
then return False
else do
ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) menv Nothing (Just handle) (Just handle)
ec3 <- waitForProcess ph3
if (ec3 /= ExitSuccess)
then return False
else do
ph4 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["test"] (Just dir) menv Nothing (Just handle) (Just handle)
ec4 <- waitForProcess ph4
if (ec4 /= ExitSuccess)
then return False
else do
ph5 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["haddock"] (Just dir) menv Nothing (Just handle) (Just handle)
ec5 <- waitForProcess ph5
return $ ec5 == ExitSuccess
let run cmd args wdir handle = do
ph <- runProcess cmd args (Just wdir) menv Nothing (Just handle) (Just handle)
ec <- waitForProcess ph
unless (ec == ExitSuccess) $ throwIO TestException
passed <- handle (\TestException -> return False) $ do
getHandle WriteMode $ run "cabal" ["unpack", package] testdir
getHandle AppendMode $ run "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] dir
getHandle AppendMode $ run "cabal-dev" ["build"] dir
getHandle AppendMode $ run "cabal-dev" ["test"] dir
getHandle AppendMode $ run "cabal-dev" ["haddock"] dir
return True
let expectedFailure = packageName `Set.member` expectedFailures
if passed
then do